Удаление защиты с листов и книги в Excel

[ZuBy]

Здравствуйте!

На форуме вроде нельзя обсуждать варез(взлом, кряки и прочие штуки)

Но когда я озадачился вопросом удалением защиты с файлов Excel (MS Office 2010) оказалось что этот способ не является варезом, т.к. Либре офис автоматически удаляет защиты, также действует и офис на iPhone.

ссылка на exe

Поэтому я и решил запостить решение на форуме
Решение на Delphi

var {глобальные}
  TempPath: string = '';
  ZipFile: string = '';

const
  BookProtect = '<workbookProtection';
  SheetProtect = '<sheetProtection';
  TagProtect = '/>';

implementation

uses System.Zip, System.IOUtils, StrUtils;

{$R *.fmx}

function Parse(const tag1, tag2, source: string): string;
var
  p, p2: Integer;
begin
  Result := '';
  p := StrUtils.PosEx(tag1, source);

  p2 := StrUtils.PosEx(tag2, source, p + tag1.Length + 1);
  if (p = 0) or (p2 = 0) then
    exit;
  if p2 > p then
    Result := (Copy(source, p + tag1.Length, p2 - p - tag1.Length));
end;

procedure TForm4.Button1Click(Sender: TObject);
var
  I: Integer;
  Zip: TZipFile;
  aXML: TStringList;
  Files: TStringDynArray;
  FoundStr, InsidePath: string;
begin
  if OpenDialog1.Execute then
  begin
    Memo1.Lines.Clear;
    ZipFile := OpenDialog1.FileName;
    if Pos('.xlsx', ZipFile) > 0 then
    begin
      TempPath := IncludeTrailingPathDelimiter(TPath.GetTempPath + 'exzip-' +
        FormatDateTime('dd-mm-yy_hh-mm-ss', now));

      Zip := TZipFile.Create;
      try
        Zip.UTF8Support := true;
        if Zip.IsValid(ZipFile) then
        begin
          Memo1.Lines.Add('[Valid]: "' + ZipFile + '"');
          TDirectory.CreateDirectory(TempPath);
          if TDirectory.Exists(TempPath) then
          begin
            Zip.ExtractZipFile(ZipFile, TempPath);
            Memo1.Lines.Add('[TempDir]: Extracted');
            InsidePath := TempPath + IncludeTrailingPathDelimiter('xl');
            aXML := TStringList.Create;
            try
              // workbook
              aXML.LoadFromFile(InsidePath + 'workbook.xml', TEncoding.UTF8);
              if Pos(BookProtect, aXML.Text) > 0 then
              // нашли защиту книги
              begin
                FoundStr := BookProtect + Parse(BookProtect, TagProtect, aXML.Text) +
                  TagProtect;
                aXML.Text := StringReplace(aXML.Text, FoundStr, '',
                  [rfReplaceAll, rfIgnoreCase]);
                aXML.SaveToFile(InsidePath + 'workbook.xml', TEncoding.UTF8);
                Memo1.Lines.Add('[WorkBook]: delete protect');
              end;

              // sheets
              InsidePath := InsidePath + IncludeTrailingPathDelimiter('worksheets');
              Files := TDirectory.GetFiles(InsidePath);

              for I := Low(Files) to High(Files) do
              begin
                aXML.Clear;
                aXML.LoadFromFile(Files[I], TEncoding.UTF8);
                if Pos(SheetProtect, aXML.Text) > 0 then
                // нашли защиту листа
                begin
                  FoundStr := SheetProtect + Parse(SheetProtect, TagProtect, aXML.Text) +
                    TagProtect;
                  aXML.Text := StringReplace(aXML.Text, FoundStr, '',
                    [rfReplaceAll, rfIgnoreCase]);
                  aXML.SaveToFile(Files[I], TEncoding.UTF8);
                  Memo1.Lines.Add('[WorkSheet]: delete protect');
                end;
              end;
            finally
              FreeAndNil(aXML);
            end;
            Memo1.Lines.Add('DONE!');
          end;
          InsidePath := IncludeTrailingPathDelimiter(TPath.GetDocumentsPath) +
            ExtractFileName(ZipFile);
          // собираем обратно в файл
          Zip.ZipDirectoryContents(InsidePath, TempPath, TZipCompression.zcDeflate);
          // подчищаем за собой
          TDirectory.Delete(TempPath, true);
          Memo1.Lines.Add('[TempDir]: deleted');
          Memo1.Lines.Add('[Saved]: "' + InsidePath + '"');
        end;
      finally
        FreeAndNil(Zip);
      end;
    end
    else
      ShowMessage('Неправильное расширение файла!' + #13#10 + 'только .XLSX' + #13#10 +
        'тестировался с Microsoft Office 2010');
  end;
end;