Повысьте эффективность поиска в документе Word с помощью OLE и Delphi

После некоторых экспериментов я получил следующий код для выполнения поиска и замены в MSWord. Этот код отлично работает также в верхнем и нижнем колонтитулах, включая случаи, когда верхний и нижний колонтитулы отличаются для первой страницы или нечетных/четных страниц.

Проблема заключается в том, что мне нужно вызвать MSWordSearchAndReplaceInAllDocumentParts для каждой строки, которую я заменяю, и я получаю неприемлемую производительность (2 минуты для примерно 50 строк в 4-страничном слове doc). В идеале это должно быть "мгновенно", конечно.

Перед обработкой верхних и нижних колонтитулов я просто выполнял поиск и замену в основном документе (используя wdSeekMainDocument). В этом случае перфмант был приемлемым (хотя и довольно медленным). Я просто удивляюсь, почему это так медленно: время переключения переключается? Обычно верхние и нижние колонтитулы содержат несколько слов, поэтому я ожидал, что все "Поиск и замена" в верхних и нижних колонтитулах не ухудшают общую производительность. Но это не то, что я наблюдал.

Это код, внизу я поставил результаты профилировщика:

// global variable (just for convenience of posting to Stack Overflow)   
var
 aWordApp: OLEVariant; // global

// This is the function that is executed once per every  string I replace
function MSWordSearchAndReplaceInAllDocumentParts;
begin
    try
      iseekValue := aWordApp.ActiveWindow.ActivePane.View.SeekView;
      iViewType := aWordApp.ActiveWindow.ActivePane.View.Type;
      if iViewType <> wdPrintView then
        aWordApp.ActiveWindow.ActivePane.View.Type := wdPrintView;
      if aWordApp.ActiveDocument.PageSetup.OddAndEvenPagesHeaderFooter then
      begin
        Try
          aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekEvenPagesFooter;
          SearchAndReplaceInADocumentPart;
        Except
            // do nothing ..it was not able to set above view
        end;
        Try
          aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekEvenPagesHeader;
          SearchAndReplaceInADocumentPart;
        Except
          // do nothing ..it was not able to set above view
        end;
      end;
      if aWordApp.ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter then
      begin
        Try
          aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekFirstPageFooter;
          SearchAndReplaceInADocumentPart;
        Except
          // do nothing ..it was not able to set above view
        end;
        Try
          aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekFirstPageHeader;
          SearchAndReplaceInADocumentPart;
        Except
          // do nothing ..it was not able to set above view
        end;
      end;
      //Replace in Main Docpart
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekMainDocument;
        SearchAndReplaceInADocumentPart;
      Except
          // do nothing ..it was not able to set above view
      end;
      //Replace in Header
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageHeader;
        SearchAndReplaceInADocumentPart;
      Except
          // do nothing ..it was not able to set above view
      end;
      //Replace in Footer
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageFooter;
        SearchAndReplaceInADocumentPart;
      Except
          // do nothing ..it was not able to set above view
      end;
      //Replace in Header
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekPrimaryHeader;
        SearchAndReplaceInADocumentPart;
      Except
        // do nothing ..it was not able to set above view
      end;
      //Replace in Footer
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekPrimaryFooter;
        SearchAndReplaceInADocumentPart;
      Except
        // do nothing ..it was not able to set above view
      end;
    finally
      aWordApp.ActiveWindow.ActivePane.View.SeekView := iseekValue;
      if iViewType <> wdPrintView then
        aWordApp.ActiveWindow.ActivePane.View.Type := iViewType;
    end;
end;

// This is the function that performs Search And Replace in the selected View
 // it is called once per view

function SearchAndReplaceInADocumentPart;
begin
    aWordApp.Selection.Find.ClearFormatting;
    aWordApp.Selection.Find.Text := aSearchString;
    aWordApp.Selection.Find.Replacement.Text := aReplaceString;
    aWordApp.Selection.Find.Forward := True;
    aWordApp.Selection.Find.MatchAllWordForms := False;
    aWordApp.Selection.Find.MatchCase := True;
    aWordApp.Selection.Find.MatchWildcards := False;
    aWordApp.Selection.Find.MatchSoundsLike := False;
    aWordApp.Selection.Find.MatchWholeWord := False;
    aWordApp.Selection.Find.MatchFuzzy := False;
    aWordApp.Selection.Find.Wrap := wdFindContinue;
    aWordApp.Selection.Find.Format := False;
    { Perform the search}
    aWordApp.Selection.Find.Execute(Replace := wdReplaceAll);
end;

Здесь я вставлю профилирующие результаты (у меня есть aqtime pro): enter image description here

Не могли бы вы помочь мне в выявлении проблемы?

Ответы

Ответ 1

Я не видел такой ужасной производительности при тестировании на своей машине, но все же есть способы повысить производительность.

Самое большое улучшение - от aWordApp.ActiveWindow.Visible до False перед вызовом MSWordSearchAndReplaceInAllDocumentParts.

Второе улучшение устанавливает aWordApp.ScreenUpdating - False.

Когда вы вызываете MSWordSearchAndReplaceInAllDocumentParts несколько раз подряд, применяйте вышеуказанные настройки один раз. Кроме того, установите ActiveWindow.ActivePane.View.Type в wdPrintView, прежде чем вызывать несколько раз MSWordSearchAndReplaceInAllDocumentParts.

Edit:

Я получил еще одно улучшение, изменив способ поиска/замены: вместо изменения SeekView, итерации по всем разделам и получения диапазона документа, верхних и нижних колонтитулов самостоятельно, а также поиска/замены по этим диапазонам.

procedure TForm1.MSWordSearchAndReplaceInAllDocumentParts(const aDoc: OleVariant);
var
  i: Integer;
  lSection: OleVariant;
  lHeaders: OleVariant;
  lFooters: OleVariant;
  lSections: OleVariant;
begin
  lSections := aDoc.Sections;
  for i := 1 to lSections.Count do
  begin
    lSection := lSections.Item(i);
    lHeaders := lSection.Headers;
    lFooters := lSection.Footers;
    if lSection.PageSetup.OddAndEvenPagesHeaderFooter then
    begin
      SearchAndReplaceInADocumentPart(lHeaders.Item(wdHeaderFooterEvenPages).Range);
      SearchAndReplaceInADocumentPart(lFooters.Item(wdHeaderFooterEvenPages).Range);
    end;
    if lSection.PageSetup.DifferentFirstPageHeaderFooter then
    begin
      SearchAndReplaceInADocumentPart(lHeaders.Item(wdHeaderFooterFirstPage).Range);
      SearchAndReplaceInADocumentPart(lFooters.Item(wdHeaderFooterFirstPage).Range);
    end;
    SearchAndReplaceInADocumentPart(lHeaders.Item(wdHeaderFooterPrimary).Range);
    SearchAndReplaceInADocumentPart(lFooters.Item(wdHeaderFooterPrimary).Range);

    SearchAndReplaceInADocumentPart(lSection.Range);
  end;
end;

procedure TForm1.SearchAndReplaceInADocumentPart(const aRange: OleVariant);
begin
  aRange.Find.ClearFormatting;
  aRange.Find.Text := aSearchString;
  aRange.Find.Replacement.Text := aReplaceString;
  aRange.Find.Forward := True;
  aRange.Find.MatchAllWordForms := False;
  aRange.Find.MatchCase := True;
  aRange.Find.MatchWildcards := False;
  aRange.Find.MatchSoundsLike := False;
  aRange.Find.MatchWholeWord := False;
  aRange.Find.MatchFuzzy := False;
  aRange.Find.Wrap := wdFindContinue;
  aRange.Find.Format := False;

  { Perform the search}
  aRange.Find.Execute(Replace := wdReplaceAll);
end;

Вы увидите даже большее улучшение, если вы откроете документ, который хотите изменить, пока приложение невидимо, или если вы открываете документ с помощью Visible: = False; (установка видимого приложения снова также отобразит документ).