{"id":1377,"date":"2011-10-17T00:07:12","date_gmt":"2011-10-17T07:07:12","guid":{"rendered":"http:\/\/www.andreanolanusse.com\/pt\/?p=1377"},"modified":"2013-05-21T20:54:44","modified_gmt":"2013-05-22T03:54:44","slug":"shell-extension-para-windows-32-bit-e-64-bit-com-delphi-xe2","status":"publish","type":"post","link":"http:\/\/www.andreanolanusse.com\/pt\/shell-extension-para-windows-32-bit-e-64-bit-com-delphi-xe2\/","title":{"rendered":"Shell Extension para Windows 32-bit e 64-bit com Delphi XE2"},"content":{"rendered":"

Com o suporte a compila\u00e7\u00e3o para windows 64-bit no Delphi XE2<\/a>, desenvolvedores passam a poder criar Shell Extensions para Windows 64-bit. Shell Extensions s\u00e3o objetos COM que estendem as capacidades do sistema operacional Windows. Nesta primera parte do artigo explico como criar, compilar para 32-bit e 64-bit e registrar \u00a0um shell extension.\u00a0O exemplo a ser utilizado ir\u00e1 adicionar dois menus de contexto ao Windows Explorer, estes novos menus ter\u00e3o como funcionalidade permitir que os usu\u00e1rios fa\u00e7am upload de arquivos para as nuvens Microsoft Azure e Amazon S3. Na segunda parte do artigo irei explicar como fazer o upload de arquivos para o Amazon S3 e Microsoft Azure utilizando o Cloud API.<\/p>\n

Criando o CloudUpload Shell Extension<\/h3>\n

Para criar um shell extension em Delphi o primeiro passo \u00e9 criar um projeto ActiveX Library e em seguinda criar um Automation Object. O exemplo utilizado neste artigo tem como nome de projeto CloudUpload e o Automation Object se chama TCloudUploadContext. Para integrar menus de contexto ao Windows Explorer a classe TCloudUploadContext ter\u00e1 de \u00a0implementar as interfaces IShellExtInit e IContextMenu e seus respectivos m\u00e9todos.<\/p>\n

    { IShellExtInit Methods }\r\n    { Initialize the context menu if a files was selected}\r\n    function IShellExtInit.Initialize = ShellExtInitialize;\r\n    function ShellExtInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;\r\n      hKeyProgID: HKEY): HResult; stdcall;\r\n\r\n    { IContextMenu Methods }\r\n    { Initializes the context menu and it decides which items appear in it,\r\n      based on the flags you pass }\r\n    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,\r\n      uFlags: UINT): HResult; stdcall;\r\n\r\n    { Execute the command, which will be the upload to Amazon or Azure}\r\n    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;\r\n    { Set help string on the Explorer status bar when the menu item is selected }\r\n    function GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT;\r\n      pszName: LPSTR; cchMax: UINT): HResult; stdcall;<\/pre>\n
O ShellExtInitialize define se o menu de contexto ser\u00e1 exibido ou n\u00e3o no Windows Explorer. Neste exemplo o menu de contexto aparece apenas e somente quando um arquivo for selecionado, a partir dai armazenamos o nome do arquivo na vari\u00e1vel FFileName.<\/p>\n
function TCloudUploadContextMenu.ShellExtInitialize(pidlFolder: PItemIDList;\r\n  lpdobj: IDataObject; hKeyProgID: HKEY): HResult;\r\nvar\r\n  DataFormat: TFormatEtc;\r\n  StrgMedium: TStgMedium;\r\n  Buffer: array [0 .. MAX_PATH] of Char;\r\nbegin\r\n  Result := E_FAIL;\r\n\r\n  { Check if an object was defined }\r\n  if lpdobj = nil then\r\n    Exit;\r\n\r\n  { Prepare to get information about the object }\r\n  DataFormat.cfFormat := CF_HDROP;\r\n  DataFormat.ptd := nil;\r\n  DataFormat.dwAspect := DVASPECT_CONTENT;\r\n  DataFormat.lindex := -1;\r\n  DataFormat.tymed := TYMED_HGLOBAL;\r\n\r\n  if lpdobj.GetData(DataFormat, StrgMedium) <> S_OK then\r\n    Exit;\r\n\r\n  { The implementation now support only one file }\r\n  if DragQueryFile(StrgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1 then\r\n  begin\r\n    SetLength(FFileName, MAX_PATH);\r\n    DragQueryFile(StrgMedium.hGlobal, 0, @Buffer, SizeOf(Buffer));\r\n    FFileName := Buffer;\r\n    Result := NOERROR;\r\n  end\r\n  else\r\n  begin\r\n    \/\/ Don't show the Menu if more then one file was selected\r\n    FFileName := EmptyStr;\r\n    Result := E_FAIL;\r\n  end;\r\n\r\n  { http:\/\/msdn.microsoft.com\/en-us\/library\/ms693491(v=vs.85).aspx }\r\n  ReleaseStgMedium(StrgMedium);\r\n\r\nend;<\/pre>\n
Depois de inicializado o handle do menu de contexto atrav\u00e9s da interface IShellExiInit, o Windows utilizar a interface IContextMenu para chamar os outros m\u00e9todos do handle do menu de contexto, neste caso ir\u00e1 chamar QueryContextMenu, GetCommandString e InvokeCommand.<\/p>\n
As op\u00e7\u00f5es do menu de contexto (Amazon S3<\/a>, Microsoft Azure<\/a>) ser\u00e3o criadas atrav\u00e9s do m\u00e9todo QueryContextMenu.<\/p>\n
function TCloudUploadContextMenu.QueryContextMenu(Menu: HMENU;\r\n  indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;\r\nvar\r\n  CloudMenuItem: TMenuItemInfo;\r\n  MenuCaption: String;\r\n  SubMenu: HMENU;\r\n  uId: UINT;\r\nbegin\r\n  { only adding one menu CloudMenuItem, so generate the result code accordingly }\r\n  Result := MakeResult(SEVERITY_SUCCESS, 0, 3);\r\n\r\n  { store the menu CloudMenuItem index }\r\n  FMenuItemIndex := indexMenu;\r\n\r\n  { specify what the menu says, depending on where it was spawned }\r\n  if (uFlags = CMF_NORMAL) then \/\/ from the desktop\r\n    MenuCaption := 'Send file from Desktop to the Cloud'\r\n  else if (uFlags and CMF_VERBSONLY) = CMF_VERBSONLY then \/\/ from a shortcut\r\n    MenuCaption := 'Send file from Shourtcut to the Cloud'\r\n  else if (uFlags and CMF_EXPLORE) = CMF_EXPLORE then \/\/ from explorer\r\n    MenuCaption := 'Send file from Explorer to the Cloud'\r\n  else\r\n    { fail for any other value }\r\n    Result := E_FAIL;\r\n\r\n  if Result <> E_FAIL then\r\n  begin\r\n\r\n    SubMenu := CreatePopupMenu;\r\n\r\n    uId := idCmdFirst;\r\n    InsertMenu(SubMenu, AmazonIndex, MF_BYPOSITION, uId, TClouds[AmazonIndex]);\r\n\r\n    Inc(uId);\r\n    InsertMenu(SubMenu, AzureIndex, MF_BYPOSITION, uId, TClouds[AzureIndex]);\r\n\r\n    FillChar(CloudMenuItem, SizeOf(TMenuItemInfo), #0);\r\n    CloudMenuItem.cbSize := SizeOf(TMenuItemInfo);\r\n    CloudMenuItem.fMask := MIIM_SUBMENU or MIIM_STRING or MIIM_ID;\r\n    CloudMenuItem.fType := MFT_STRING;\r\n    CloudMenuItem.wID := FMenuItemIndex;\r\n    CloudMenuItem.hSubMenu := SubMenu;\r\n    CloudMenuItem.dwTypeData := PWideChar(MenuCaption);\r\n    CloudMenuItem.cch := Length(MenuCaption);\r\n\r\n    InsertMenuItem(Menu, indexMenu, True, CloudMenuItem);\r\n  end;\r\nend;<\/pre>\n
Quando o usu\u00e1rio estiver no Windows Explorer e passar o mouse sobre um dos menus criados, uma mensagem ser\u00e1 exibida na barra de status do Windows Explorer, isso acontece devido a implementa\u00e7\u00e3o do m\u00e9todo GetCommandString, o qual retorna a string a ser exibida pelo Windows Explorer.<\/p>\n
function TCloudUploadContextMenu.GetCommandString(idCmd: UINT_PTR; uFlags: UINT;\r\npwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;\r\nbegin\r\n  Result := E_INVALIDARG;\r\n\r\n  { Set help string on the Explorer status bar when the menu item is selected }\r\n  if (idCmd in [AmazonIndex, AzureIndex]) and (uFlags = GCS_HELPTEXT) then\r\n  begin\r\n    StrLCopy(PWideChar(pszName), PWideChar('Copy the selected file to ' +\r\n      TClouds[idCmd]), cchMax);\r\n    Result := NOERROR;\r\n  end;\r\n\r\nend;<\/pre>\n
Assim que usu\u00e1rio clicar no menu referente a nuvem que deseja enviar o arquivo, o m\u00e9todo InvokeCommand ser\u00e1 chamado e dar\u00e1 inicio o processo para fazer o upload do arquivo selecionado. Neste ponto j\u00e1 temos o nome do arquivo e com base nos par\u00e2metros lpici podemos identificar o qual dos items de menu o usu\u00e1rio clicou.<\/p>\n
function TCloudUploadContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;\r\nvar\r\n  Item: Word;\r\nbegin\r\n  Result := E_FAIL;\r\n\r\n  if HiWord(Integer(lpici.lpVerb)) <> 0 then\r\n    Exit;\r\n\r\n  { if the index matches the index for the menu, show the cloud options }\r\n  Item := LoWord(Integer(lpici.lpVerb));\r\n\r\n  if Item in [AmazonIndex, AzureIndex] then\r\n  begin\r\n    try\r\n      Upload(lpici.HWND, Item, FFileName);\r\n    except\r\n      on E: Exception do\r\n        MessageBox(lpici.hwnd, PWideChar(E.Message), 'Cloud Upload', MB_ICONERROR);\r\n\r\n    end;\r\n    Result := NOERROR;\r\n  end;\r\n\r\nend;<\/pre>\n
Para que o objeto COM seja criado sempre que o CloudUpload \u00e9 carregado, \u00e9 necess\u00e1rio criar uma inst\u00e2ncia da classe factory o qual ir\u00e1 criar uma inst\u00e2ncia do objeto shell extension. A inst\u00e2ncia da classe factory ser\u00e1 criada na se\u00e7\u00e3o initialization conforme o c\u00f3digo abaixo, veja que o c\u00f3digo original criado pelo Delphi ser\u00e1 substituido por este.<\/p>\n
initialization\r\n  TCloudUploadObjectFactory.Create(ComServer, TCloudUploadContextMenu, CLASS_CloudUploadContextMenu, ciMultiInstance, tmApartment);\r\nend.<\/pre>\n
Uma vez que a classe factory ser\u00e1 respons\u00e1vel por registrar\/desregistrar a DLL, os m\u00e9todos ApproveShellExtension e UpdateRegistry ser\u00e3o chamados, isso vai acontecer quando voc\u00ea usar o regsvr32.exe.<\/p>\n
  { the new class factory }\r\n  TCloudUploadObjectFactory = class(TAutoObjectFactory)\r\n  protected\r\n    procedure ApproveShellExtension(&Register: Boolean; const ClsID: string);\r\n    function GetProgID: string; override;\r\n  public\r\n    procedure UpdateRegistry(Register: Boolean); override;\r\n  end;\r\n\r\n{ TCloudUploadObjectFactory }\r\n\r\n{ Required to registration for Windows NT\/2000 }\r\nprocedure TCloudUploadObjectFactory.ApproveShellExtension(&Register: Boolean;\r\n  const ClsID: string);\r\nConst\r\n  WinNTRegKey =\r\n    'SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Shell Extensions\\Approved';\r\nvar\r\n  Reg: TRegistry;\r\nbegin\r\n  Reg := TRegistry.Create;\r\n\r\n  try\r\n    Reg.RootKey := HKEY_LOCAL_MACHINE;\r\n\r\n    if not Reg.OpenKey(WinNTRegKey, True) then\r\n      Exit;\r\n\r\n    { register the extension appropriately }\r\n    if &Register then\r\n      Reg.WriteString(ClsID, Description)\r\n    else\r\n      Reg.DeleteValue(ClsID);\r\n  finally\r\n    Reg.Free;\r\n  end;\r\n\r\nend;\r\n\r\nfunction TCloudUploadObjectFactory.GetProgID: string;\r\nbegin\r\n  { ProgID not required for shell extensions }\r\n  Result := '';\r\nend;\r\n\r\nprocedure TCloudUploadObjectFactory.UpdateRegistry(Register: Boolean);\r\nConst\r\n  ContextKey = '*\\shellex\\ContextMenuHandlers\\%s';\r\nbegin\r\n  { perform normal registration }\r\n  inherited UpdateRegistry(Register);\r\n\r\n  { Registration required for Windows NT\/2000 }\r\n  ApproveShellExtension(Register, GUIDToString(ClassID));\r\n\r\n  { if this server is being registered, register the required key\/values\r\n    to expose it to Explorer }\r\n  if Register then\r\n    CreateRegKey(Format(ContextKey, [ClassName]), '', GUIDToString(ClassID),\r\n      HKEY_CLASSES_ROOT)\r\n  else\r\n    DeleteRegKey(Format(ContextKey, [ClassName]));\r\n\r\nend;<\/pre>\n
Compilar para plataformas 32-bit ou 64-bit<\/h3>\n
A partir daqui preciamos apenas compilar o projeto, neste exemplo as API’s do Windows e os m\u00e9todos da RTL s\u00e3o os mesmos para as plataformas 32-bit e 64-bit, assim sendo n\u00e3o precisamos fazer implementa\u00e7\u00f5es espec\u00edficas para cada plataforma. Voc\u00ea pode definir para qual plataforma deseja compilar utilizando o Project Manager, o default \u00e9 32-bit Windows, use o bot\u00e3o direito do mouse na op\u00e7\u00e3o Target Platforms para adicionar 64-bit Windows.<\/p>\n
\"\"<\/a><\/p>\n
Voc\u00ea n\u00e3o pode registrar dll 32-bit em sistema operacional 64-bit, assim como n\u00e3o pode registrar dll 64-bit em sistema operacional 32-bit. Se voc\u00ea desenvolve, compila e teste seus projeto na sua m\u00e1quina de desenvolvimento, compile para a plataforma compat\u00edvel com o sistema operacional em uso.<\/p>\n
 <\/p>\n
Registrando o Shell Extension CloudUpload<\/h3>\n
Primeiro, voc\u00ea tem que executar em modo “Run as Administrator” a aplica\u00e7\u00e3o que ser\u00e1 utilizada para registrar o shell extension, mesmo que seu usu\u00e1rio tenha direitos de Administrador.<\/p>\n
Shell extensions 32-bit pode ser registradas atrav\u00e9s do IDE, linha de comando (cmd) pode ser usada para registrar 32-bit e 64-bit.<\/p>\n
Abaixo os passos para registrar e cancelar o registro atrav\u00e9s de linha de comando:<\/p>\n
– “Run as Administrator” o cmd;<\/p>\n
– Registre a extens\u00e3o utilizando a linha de comando: regsvr32 <DIRET\u00d3RIO ONDE EST\u00c1 A DLL>CloudUpload.dll<\/p>\n
– Para desregistrar a extens\u00e3o utilize a seguinte linha de comando: regsvr32 <DIRET\u00d3RIO ONDE EST\u00c1 A DLL >CloudUpload.dll \/u<\/p>\n
Efetuado o registro da DLL abra o Windows Explorer, selecione um arquivo e utilize o bot\u00e3o direito do mouse, voc\u00ea ver\u00e1 um novo menu “Send file from Explorer to the Cloud”. No screenshot abaixo voc\u00ea pode ver a extens\u00e3o no Windows 7 64-bit.<\/p>\n
\"\"<\/a><\/p>\n
Voc\u00ea pode obter o c\u00f3digo fonte do exemplo aqui utilizado de duas formas:<\/p>\n