Форум программистов [Powered by Invision Power Board]

Код

uses ShlObj, ActiveX;

...
{ Проверка на расширение не требуется }
function ShowExtractFilesDialog(const ZipFile: String): Boolean;
var
  Malloc: IMalloc;
  Desktop: IShellFolder;
  Archive: IShellFolder2;
  ID: PItemIDList;
  CM: IContextMenu;
  ICI: TCMInvokeCommandInfo;
begin
  Result := Succeeded(CoGetMalloc(1, Malloc));
  if Result then
  try
    Result := Succeeded(SHGetDesktopFolder(Desktop));
    if Result then
    try
      Result := Succeeded(Desktop.ParseDisplayName(0, nil,
        StringToOleStr(ZipFile), PULONG(nil)^, ID, PULONG(nil)^));
      if Result then
      try
        Result := Succeeded(Desktop.BindToObject(ID, nil,
          IID_IShellFolder2, Archive));
        if Result then
        try
          Result := Succeeded(Archive.CreateViewObject(0, IID_IContextMenu, CM));
          if Result then
          try
            { Небольшое допущение }
            FillChar(ICI, SizeOf(ICI), #0);
            with ICI do
            begin
              cbSize := SizeOf(ICI);
              nShow := SW_SHOWNORMAL;
            end;
            Result := Succeeded(CM.InvokeCommand(ICI));
          finally
            CM := nil;
          end;
        finally
          Archive := nil;
        end;
      finally
        Malloc.Free(ID);
      end;
    finally
      Desktop := nil;
    end;
  finally
    Malloc := nil;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    ShowExtractFilesDialog(OpenDialog1.FileName);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CoInitialize(nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CoUninitialize();
end;