Menú Contextual

La gente copiaba sus álbumes desde el pc a su mp3, en el pc los temas aparecían ordenados alfabéticamente por el título, que normalmente iban precedidos por el ordinal correspondiente tal que alfabéticamente se reprodujesen en su mismo orden del álbum. Pero Windows en una selección múltiple copia los temas según el orden de la FAT del sistema de archivos que no suele corresponder precisamente. Entonces al reproducir los temas del álbum en su mp3 se encontraban con que no estaban en el orden que pretendían. Esta opción añadida al sistema proporcionaba la solución al problema   

ContExtCopyAlf.dll

 {

      Módulo MenuContextual

      Objeto COM que implementa las interfaces IShellExtInit e IContextMenu,

      para crear un gestor de extensión de la Shell - menú contextual -

      controla la selección de una única carpeta que contenga más de un archivo,

      o varios archivos (más de uno) que no sean carpetas.

      Se crea una copia en el portapapeles con los archivos

      ordenados alfabéticamente para pegar en el sistema de archivo.

      JMCP     (c)Febrero 2006

}    

Unit MenuContextual;

Interface

Uses

    Windows, ComObj, ShlObj, ComServ, ShellApi, ActiveX, SysUtils;

Const  // Este es el identificador único para nuestra extensión

   CLSID_MenuContextual: TGUID = '{39F382A0-55FA-11D1-9A28-004033CA9316}';

Type

    // Derivamos nuestra clase de TComObject, indicando que se

    // van a implementar las interfaces IShellExtInit e IContextMenu

    TMenuContextual = Class(TComObject, IShellExtInit, IContextMenu)

    Private

      sPath, sCarpeta: String;

      lstArchivos: Array[0..999] Of String;

      strData, strDirs: String;

      nFiles: Integer; // no. de archivos

      procedure SortFiles();

      function LeeCarpeta(const szCarpeta: PChar): Boolean;

      function CopiaXCarpeta(hWnd: HWND): Boolean;

      function LeeDirs(strCarpeta: String): Integer;

    Public

          // Este método de la interfaz IContextMenu permite añadir

          // la opción al menú contextual

      Function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,

        uFlags: UINT): HResult; Stdcall;

          // Este método, también de IContextMenu, es el usado para

          // ejecutar las opciones añadidas al menú

      Function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; Stdcall;

          // Tercer método de la interfaz IContextMenu, su finalidad

          // es devolver una cadena de descripción de la opción indicada

      Function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;

        pszName: LPSTR; cchMax: UINT): HResult; Stdcall;

          // Único método de la interfaz IShellExtInit, cuya finalidad

          // es inicializar el objeto facilitándole información sobre

          // los archivos seleccionados al pulsar el botón derecho

      Function Initialize (pidlFolder: PItemIDList; lpdobj: IDataObject;

        hKeyProgID: HKEY): HResult; Stdcall;

    End;

Implementation

// Este método de la interfaz IContextMenu es llamado por

// la shell de Windows cuando se va a desplegar el menú -

// emergente, ofreciendo así la posibilidad de añadir opciones

Function TMenuContextual.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,

          idCmdLast, uFlags: UINT): HResult;

Begin

     // Añadimos nuestra opción en la posición indexMenu con el

     // identificador idCmdFirst

  InsertMenu (Menu, indexMenu, MF_STRING + MF_BYPOSITION, idCmdFirst, 'Copiar Al&fabéticamente');

     // Devolvemos el número de opciones añadidas

  Result := 1;

End;

    // Este método de la interfaz IContextMenu es llamado por

    // la shell de Windows para recuperar una descripción de

    // una de las opciones añadidas al menú contextual

Function TMenuContextual.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;

  pszName: LPSTR; cchMax: UINT): HRESULT;

Begin

     Result := NOERROR; // Asumimos que no hay problema

     Case idCmd Of // Según la opción que sea

          0: // copiamos un descripción u otra en pszName

            StrLCopy(pszName, PChar('Copia de (' + Format('%d',[nFiles])

             + ') archivos en orden alfabético.'

             + ' Utilice Pegar para ponerlos en una ubicación nueva.'), cchMax-1);

          Else // si no es ninguna de nuestras opciones

               Result := E_INVALIDARG; // devolvemos un error

     End;

End;

    // Este método de la interfaz IContextMenu es llamado por

    // la shell de Windows cuando se el usuario elige una de

    // las opciones añadidas por nosotros, dándonos así opción

    // a ejecutar el proceso que corresponda

Function TMenuContextual.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;

            var

              res: Boolean;

              i:   Integer;

              df:  DROPFILES;

              hgd, hge, hgf:  Cardinal;

              lpgd, lpge, lpgf:  Pointer;

              CF_PREFERREDDROPEFFECT, CF_FILENAME : TClipFormat;

Begin

     Result := E_FAIL; // error

     res := TRUE;

     Case LoWord(lpici.lpVerb) Of // Según la opción elegida

       0:

       Begin

         If Length(sCarpeta) > 0 Then

         Begin

           {

           MessageBox(lpici.hwnd,

              PChar('Archivos de ' + sPath + ' la carpeta ' + sCarpeta

               + Format(' (%d)', [nFiles])), 'Copiar Alfabéticamente', MB_OK);

           }

           res := CopiaXCarpeta(lpici.hwnd); // recopia (crea, copia y renombra) carpeta

         End;

         If OpenClipboard(0) And res Then

         Try

          Begin

            EmptyClipboard();

            // Reg. tipos

            CF_PREFERREDDROPEFFECT := RegisterClipboardFormat(CFSTR_PREFERREDDROPEFFECT);

            CF_FILENAME := RegisterClipboardFormat(CFSTR_FILENAMEA);

            // mem para DROPEFFECT

            hge := GlobalAlloc(GHND, SizeOf(Cardinal));

            If hge <> 0 Then

            Begin

              lpge := GlobalLock(hge);

              Cardinal(lpge^) := DROPEFFECT_COPY;

              GlobalUnlock(hge);

              SortFiles();

              strData := '';

              For i := 0  to nFiles-1 do

                 strData := strData + sPath + lstArchivos[i] + #0;

              strData := strData + #0;

              // mem para DROP

              hgd := GlobalAlloc(GHND + GMEM_DDESHARE, Length(strData) + SizeOf(df));

              If hgd <> 0 Then

              Begin

               lpgd := GlobalLock(hgd);

               df.pFiles := SizeOf(df);

               CopyMemory(lpgd, @df, SizeOf(df));

               CopyMemory(PChar(lpgd)+SizeOf(df), PChar(strData), Length(strData));

               GlobalUnlock(hgd);

               // mem para CF_FILENAME (antiguo formato de Windows 3.1x)

               hgf := GlobalAlloc(GHND, Length(strData));

               If hgf <> 0 Then

               Begin

                lpgf := GlobalLock(hgf);

                CopyMemory(lpgf, PChar(strData), Length(strData));

                GlobalUnlock(hgf);

               End;

               // poner Clips

               If (SetClipboardData(CF_PREFERREDDROPEFFECT, hge) <> 0) And

                  (SetClipboardData(CF_HDROP, hgd) <> 0) And

                  (SetClipboardData(CF_FILENAME, hgf) <> 0) Then

                 Result := NOERROR;

              End;

            End;

          End;

         Finally

            // Terminar

            CloseClipboard();

         End;

       End; // case 0

     Else     // otras?

          Result := E_INVALIDARG;

     End; // case

End;

// .........

// Este método de la interfaz IShellExtInit es llamado por la

// shell de Windows para inicializar el objeto, entregándole

// información sobre los archivos seleccionados

Function TMenuContextual.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;

  hKeyProgID: HKEY): HResult;

Var

   Medio:   TStgMedium;

   Formato: TFormatEtc;

   Datos:   TSHFILEINFO;

   strFile: string;

   szFile:  Array[0..MAX_PATH] Of Char; // Nombre con Path

   i, k, cnt: Integer;

Begin

      Result := E_FAIL; // inicialmente por defecto

      //

      If lpdobj = Nil Then // Si no hay elementos seleccionados

            Exit; // devolvemos un error y no continuamos

      With Formato Do // Preparamos Formato

       Begin

           cfFormat := CF_HDROP; // formato arrastrar-soltar

           ptd := Nil; // sin dispositivo de destino

           dwAspect := DVASPECT_CONTENT; // queremos el contenido

           lindex := -1; // de toda la información

           tymed := TYMED_HGLOBAL; // en memoria

       End;

      // Preparamos los datos apuntados por lpdobj, que es una interfaz IDataObject,

      // en un medio de almacenamiento HGLOBAL en formato CF_HDROP

      If lpdobj.GetData(Formato, Medio) < 0 Then // Si no ha sido posible

         Exit; // no continuamos

         // Si hay seleccionado más de un archivo (NO FOLDER) pueden ordenarse

         // y los copiamos en el array lstArchivos

      cnt := DragQueryFile(Medio.hGlobal, $FFFFFFFF, Nil, 0);

      If cnt > 1 then

        Begin

          k := 0;

          for i := 0 to cnt-1 do

          Begin

            DragQueryFile(Medio.hGlobal, i, szFile, MAX_PATH);

            SHGetFileInfo(szFile, 0, Datos, SizeOf(Datos), SHGFI_ATTRIBUTES);

            If ((Datos.dwAttributes And SFGAO_FILESYSTEM ) <> 0) And

               ((Datos.dwAttributes And SFGAO_FOLDER) = 0) then

            Begin

                SetString(strFile, szFile, StrLen(szFile));

                if k = 0 Then

                    sPath := ExtractFilePath(strFile);

                //

                lstArchivos[k] := ExtractFileName(strFile);

                Inc(k);

            End;

          End;

          nFiles := k;

          If k > 1 then

            Result := NOERROR;

        End

      Else

        If cnt = 1 Then // debe ser una carpeta

        Begin

           DragQueryFile(Medio.hGlobal, 0, szFile, MAX_PATH);

           SHGetFileInfo(szFile, 0, Datos, SizeOf(Datos), SHGFI_ATTRIBUTES);

           If ((Datos.dwAttributes And SFGAO_FOLDER) <> 0) And

              (LeeCarpeta(szFile))  then

               Result := NOERROR;

        End;

      // final

      ReleaseStgMedium(Medio); // Liberamos el medio

End;

// ..........

Initialization // Al inicializar el módulo

         // Creamos el objeto identificador por el CLSID_MenuContextual,

         // indicando que la clase es TMenuContextual y que el servidor COM es ComServer

    TComObjectFactory.Create(ComServer, TMenuContextual, CLSID_MenuContextual,

         '', 'Extensión Shell para copia alf. de archivos', ciMultiInstance);

End.

_______________________

REGEDIT4

[HKEY_CLASSES_ROOT\CLSID\{39F382A0-55FA-11D1-9A28-004033CA9316}] 

@= "Extension Context Menu para Copiar archivos Alfabéticamente"

[HKEY_CLASSES_ROOT\CLSID\{39F382A0-55FA-11D1-9A28-004033CA9316}\InProcServer32] 

@= "ContExtCopyAlf.dll"

"ThreadingModel" = "Apartment"

[HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\CopiarAlf] 

@= "{39F382A0-55FA-11D1-9A28-004033CA9316}"

[HKEY_CLASSES_ROOT\Folder\shellex\ContextMenuHandlers\CopiarAlf] 

@= "{39F382A0-55FA-11D1-9A28-004033CA9316}"