Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年01月30日] [更新 2016年10月19日]　Delphi サンプルプログラム集
   
434_ワードやエクセルの文書内のテキストを取出す
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + xdoc2txt2.00
434_TextFromDocs.zip　[2,435 KB]　2016年10月19日版 (EXE 同梱)



  • 2010年02月02日
  • リスト3 を追加
  • 2013年12月22日
  • xdoc2txt2.00 で動作確認
  • 2014年11月14日
  • xdoc2txt のサイトへのリンク切れを修正
  • DLL を使用したサンプルを追加



ワードやエクセルの文書内のテキストを取出す


ワードやエクセル，その他，パワーポイント，PDF ファイル内のテキストだけを取出すテストプログラムです．実際の抽出には，[xdoc2txt － PDF, WORD, EXCEL, 一太郎などの各種バイナリ文書からテキストを抽出] を利用してみました．xdoc2txt はコマンドライン，ActiveX, DLL 形式で提供されていますが，ここではコマンドラインから実行する方法と，DLL を使用する方法をテストしています．
コマンドラインの実行には，[552_コマンドラインのリダイレクト] の plCommandRedirect を利用しています．

コマンドラインを使用したサンプルは，ワード文書やエクセルのブック内のユニコード文字には対応していません．詳しくは xdoc2txt のマニュアルと [552_パイプを使用したコマンドラインのリダイレクト] の記事を参考にしてください．
後述の DLL を使用したサンプルであれば，ユニコードな文字も正常に取得できます．





01_基本テスト


[ファイル選択] ボタンをクリックしてファイルを選択します．選択したファイルのテキストを取出して TRichEdit に表示します．テキストファイルは選択しても無効です．

xdoc2txt.exe を，本サンプルプログラムのルートフォルダに置いてテストしてください．



図1
設計時画面
図2
選択したファイル内のテキスト
  • 添付のワード文書の例

リスト1
ワードやエクセル文書内のテキストを抽出して表示		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    RichEdit1: TRichEdit;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plCommandRedirect;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  OpenDialog1.InitialDir := ExpandFileName('../SampleDocs');

  //選択するファイルの拡張子を設定
  OpenDialog1.Filter := 'テストファイル選択|' +
                        '*.doc;'  +
                        '*.docx;' +
                        '*.xls;'  +
                        '*.xlsx;' +
                        '*.rtf;'  +
                        '*.ppt;'  +
                        '*.pptx;' +
                        '*.doc;'  +
                        '*.xls;'  +
                        '*.sxw;'  +
                        '*.sxc;'  +
                        '*.sxi;'  +
                        '*.sxd;'  +
                        '*.jtd;'  +
                        '*.jtt;'  +
                        '*.pdf;'  +
                        '*.mht;'  +
                        '*.htm;'  +
                        '*.html';
end;

//=============================================================================
//  OpenDialog1で選択したファイル内のテキストをRichEditに表示
//  xdoc2txt.exeを利用
//
//  usesにplCommandRedirectが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LdocFilePath : string;
  LCmdLine     : TplCommandRedirect;
  LCmdStr      : string;
begin
  if OpenDialog1.Execute() then begin
    OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);

    RichEdit1.Clear;
    RichEdit1.Update;
    LdocFilePath := OpenDialog1.FileName;
    LCmdLine     := TplCommandRedirect.Create;
    try
      LCmdStr := ExpandFileName('../xdoc2txt') + ' ' + LdocFilePath;
      RichEdit1.Text := LCmdLine.GrabStdOutText(LCmdStr);
    finally
      FreeAndNil(LCmdLine);
    end;
  end;
end;

end.


ShellExecute 関数等で xdoc2txt.exe を使用する場合は，コマンドプロセッサ (コマンドプロンプト) の起動パラメータに xdoc2txt.exeを指定して実行します．出力のテキストは，リダイレクト機能を使用してテキストファイルとして保存します．



リスト2
ShellExecute 関数で xdoc2txt.exe を実行する場合		 
//=============================================================================
//  OpenDialog1で選択したファイル内のテキスト取得
//  ShellExecute 関数で xdoc2txt.exeを実行
//  リダイレクト機能を使用して結果をテキストファイルとして保存
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LdocFilePath  : string;
  LSaveFilePath : string;
  LCmdStr       : string;
  LRet          : Integer;
begin
  if OpenDialog1.Execute() then begin
    OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);

    RichEdit1.Clear;
    RichEdit1.Update;

    LdocFilePath  := OpenDialog1.FileName;
    LSaveFilePath := ChangeFileExt(LdocFilePath, '.txt');

    // コマンドプロンプト (cmd.exe) のオプションは /c とする
    // リダイレクト機能を使用してテキストをファイルに保存
    LCmdStr := '/c ' + ExpandFileName('../xdoc2txt') + ' ' + LdocFilePath
             + ' > ' + LSaveFilePath;

    LRet := ShellExecute(0, '','cmd.exe', PChar(LCmdStr), nil, SW_HIDE);
    if LRet > 32 then begin
      RichEdit1.Lines.LoadFromFile(LSaveFilePath);
    end;
  end;
end;



02_文書内に指定文字列を含む文書名をリスト


任意のディレクトリ内の文書のうち，テキスト部分に検索対象の文字列がある文書のリストを作成します．リストをクリックすると，その文書を表示します．文書のオブジェクト (インスタンス) を生成して操作すれば，検索文字列に関連した操作も可能となるでしょう．
このテストで使用している文字列検索のコードは，Halbow 資料館の [第５章 文字列の操作 ５－１ 部分文字列を数える] を Unicode 対応に修正したものとなっています．

xdoc2txt.exe を，本サンプルプログラムのルートフォルダに置いてテストしてください．



図3
設計時画面
図4
検索文字列がある文書のリスト
図5
クリックするとその文書を表示

リスト3
指定文字列がある文書を検索 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    ListView1: TListView;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ListView1Click(Sender: TObject);
  private
    { Private 宣言 }
    BaseDir : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plCommandRedirect,
  FileCtrl,
  Types,
  IOUtils,
  ShellAPI;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  文字列検索関数
//  Halbow資料館の以下のページのList1をUnicode対応にしたもの
//  ../../Halbow/VCL05.html#VChap5-1
//  StrLICompをStrLComp(Iがない)関数にすると大文字と小文字を区別した検索となる
//
//  SearchOP
//  1つでも見つかればいい場合はFalse,検索数を調査する場合はTrue
//
//  StrEnd(SysUtils.pas)
//  ヌルで終わる文字列の末尾を指すポインタを返す関数
//-----------------------------------------------------------------------------
function HowManyWords(const Str, SubStr: string; SearchOP: Boolean=True): Integer;
var
  LpStr    : PChar;
  LpSubStr : PChar;
  LCount   : Integer;
  LpStrEnd : PChar;
begin
  Result := 0;
  LCount := Length(SubStr);
  if LCount = 0 then exit;

  LpStr    := @Str[1];
  LpSubStr := @SubStr[1];
  LpStrEnd := StrEnd(LpStr);

  while LpStrEnd > LpStr do begin
    if StrLIComp(LpStr, LpSubStr, LCount) = 0 then begin
      //見つかったら検索文字数だけ次へ
      Inc(result);
      if SearchOP = False then break;
      Inc(LpStr, LCount);
    end else begin
      //見つからなかったら1文字だけ次へ
      Inc(LpStr, 1);
    end;
    Application.ProcessMessages;
  end;
end;

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  //テスト用のディレクトリのファイルをリストするように設定
  BaseDir := ExpandFileName('../SampleDocs');

  //テスト用文字列
  Edit1.Text := '東荻';
end;

//=============================================================================
//  フォームをリサイズしたらListViewの表示幅も変更
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  ListView1.Column[0].Width := ListView1.ClientWidth;
end;

//=============================================================================
//  Edit1に入力した文字列が含まれる文書名のリストを作成
//  plCommandRedirectをusesに追加して利用
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//  TDirectory,TPathの使用にはusesにIOUtilsが必要
//  TStringDynArrayの使用にはusesにTypesが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDirList : TStringDynArray;
  LStrList : TStringList;
  LCmdLine : TplCommandRedirect;
  LCmdStr  : string;
  LItem    : TListItem;
  i        : Integer;
begin
  if FileCtrl.SelectDirectory('検索フォルダ指定', '', BaseDir) then
  begin
    ListView1.Clear;
    ListView1.Update;

    LStrList := TStringList.Create;
    LCmdLine := TplCommandRedirect.Create;

    try
      //Base内のディレクトリのリスト作成
      LDirList := TDirectory.GetFiles(BaseDir);
      ListView1.Items.BeginUpdate;

      for i := 0 to Length(LDirList) - 1 do begin
        //SLが空でなく検索文字列があればければリストに追加
        LCmdStr := ExpandFileName('../xdoc2txt') + ' ' + LDirList[i];
        LStrList.Text := LCmdLine.GrabStdOutText(LCmdStr);

        if Length(LStrList.Text) > 0 then begin
          if HowManyWords(LStrList.Text, Edit1.Text, False) > 0 then begin
            LItem := ListView1.Items.Add;
            LItem.Caption := LDirList[i];
          end;
        end;
      end;
      ListView1.Items.EndUpdate;
    finally
      FreeAndNil(LCmdLine);
      FreeAndNil(LStrList);
    end;
  end;
end;

//=============================================================================
//  ListViewをクリックしたらその文書を表示
//  その文書のインスタンス(ワードであればワードの)作成すれば，文書内の検索文字
//  列に対する操作も可能
//
//  ShellExecuteの使用にはueseにShellAPIが必要
//=============================================================================
procedure TForm1.ListView1Click(Sender: TObject);
var
  LIndex    : Integer;
  LFilePath : string;
begin
  LIndex := ListView1.Selected.Index;
  if LIndex >= 0 then begin
    LFilePath := ListView1.Selected.Caption;
    ShellExecute(Handle, '', PChar(LFilePath), '', nil, SW_SHOW);
  end;
end;

end.


もしファイル名のリストを，ディレクトリ名を除いたファイル名だけにしたい場合は，ファイルのフルパスをどこかに記憶しておく必要があります．文字列配列を別に用意して，TListview の Item 番号と関連付ける方法もありますが，簡単なのは以下のように TListView の Data プロパティにフルパスを代入しておくことです．そうすれば，Item が移動しても気にする必要がありません．
この場合，TListView の OnDeletion イベントで Data プロパティのオブジェクトを破棄しておかなければなりません．


図6
ファイル名のみ表示

リスト4
ListViewのDataプロパティを利用する 
//=============================================================================
//  Edit1に入力した文字列が含まれる文書名のリストを作成
//  plCommandRedirectをusesに追加して利用
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//  TDirectory,TPathの使用にはusesにIOUtilsが必要
//  TStringDynArrayの使用にはusesにTypesが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //--------------------------------------------------------------------------
  function NewStr(s: string): PString;
  begin
    New(Result);
    result^ := s;
  end;
  //--------------------------------------------------------------------------

var
  LDirList : TStringDynArray;
  LStrList : TStringList;
  LCmdLine : TplCommandRedirect;
  LCmdStr  : string;
  LItem    : TListItem;
  i        : Integer;
begin
  if FileCtrl.SelectDirectory('検索フォルダ指定', '', BaseDir) then begin
    ListView1.Clear;
    ListView1.Update;

    LStrList := TStringList.Create;
    LCmdLine := TplCommandRedirect.Create;

    try
      //Base内のディレクトリのリスト作成
      LDirList := TDirectory.GetFiles(BaseDir);
      ListView1.Items.BeginUpdate;

      for i := 0 to Length(LDirList) - 1 do begin
        //SLが空でなく検索文字列があればければリストに追加
        LCmdStr := ExpandFileName('../xdoc2txt') + ' ' + LDirList[i];
        LStrList.Text := LCmdLine.GrabStdOutText(LCmdStr);

        if Length(LStrList.Text) > 0 then begin
          if HowManyWords(LStrList.Text, Edit1.Text, False) >0 then begin
            LItem := ListView1.Items.Add;
            //リストへの表示は(ディレクトリ名を除いた)ファイル名のみとする
            LItem.Caption := ExtractFileName(LDirList[i]);
            //代わりにDataプロパティにフルパスを代入しておく
            LItem.Data := NewStr(LDirList[i]);
          end;
        end;
      end;
      ListView1.Items.EndUpdate;
    finally
      FreeAndNil(LCmdLine);
      FreeAndNil(LStrList);
    end;
  end;
end;

//=============================================================================
//  ListViewをクリックしたらその文書を表示
//  その文書のインスタンス(ワードであればワードの)作成すれば，文書内の検索文字
//  列に対する操作も可能
//
//  ShellExecuteの使用にはueseにShellAPIが必要
//=============================================================================
procedure TForm1.ListView1Click(Sender: TObject);
var
  LFilePath : string;
begin
  if ListView1.Selected = nil then Exit;

  //ItemのDataプロパティに保存先のフルパスが代入されている
  LFilePath := PString(ListView1.Selected.Data)^;
  ShellExecute(Handle, '', PChar(LFilePath), '', nil, SW_SHOW);
end;

//=============================================================================
//  ListViewのItemに代入したオブジェクトを解放
//=============================================================================
procedure TForm1.ListView1Deletion(Sender: TObject; Item: TListItem);
begin
  if Item.Data <> nil then Dispose(PString(Item.Data));
end;



03_DLL を使用したサンプル  -  BSTR 型の文字列の扱いに注意


xdoc2txt には DLL 版もあります．その DLL を使用したサンプルです．
xd2txlib.dll をプロジェクトのフォルダ内に置いて実行してください．


図7
xd2txlib.dll をプロジェクトのフォルダにコピーして使用

DLL 内の ExtractText 関数を使用しますが，この関数の定義は xdoc2txt に添付の文書によると，以下のようになっています．
最初の引数は BSTR (Basic string or binary string) となっています．BSTR 型は WideString 型と互換性があります．最後の引数は BSTR * となっています．したがって，PWideString 型とします．この引数は，Delphi で言う var 渡しです．この引数には，その文字列のアドレスを与えます．そうしないと，たとえ関数がエラーなしで実行されても，正しい結果が得られません．

BSTR は，TBSTr として，ActiveX.pas に定義があります． 



  int ExtractText(BSTR lpFileName,  // 入力ファイル名
      bool bProp,                   // T:プロパティの抽出 F:本文テキストの抽出
      BSTR *lpFileText)             // 抽出したテキスト

  テキストの抽出結果はUTF16です。


  //Delphiで使用可能なコードに変換した例
  TExtractTextFunc = function (lpFileName: WideString;
                               bProp: BOOL;
                               plpFileText: PWideString): Integer; stdcall;


以下が実行結果の例と，テストに使用したコードです．


図8
実行結果例
  • ユニコードな文字も取得できる

リスト5
xdoc2txt の DLL を使用したサンプル		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    RichEdit1: TRichEdit;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TExtractTextFunc = function (lpFileName: WideString;
                               bProp: BOOL;
                               plpFileText: PWideString): Integer; stdcall;

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  OpenDialog1.InitialDir := ExpandFileName('../SampleDocs');

  //選択するファイルの拡張子を設定
  OpenDialog1.Filter := 'テストファイル選択|' +
                        '*.doc;'  +
                        '*.docx;' +
                        '*.xls;'  +
                        '*.xlsx;' +
                        '*.rtf;'  +
                        '*.ppt;'  +
                        '*.pptx;' +
                        '*.doc;'  +
                        '*.xls;'  +
                        '*.sxw;'  +
                        '*.sxc;'  +
                        '*.sxi;'  +
                        '*.sxd;'  +
                        '*.jtd;'  +
                        '*.jtt;'  +
                        '*.pdf;'  +
                        '*.mht;'  +
                        '*.htm;'  +
                        '*.html';
end;

//=============================================================================
//  OpenDialog1で選択したファイル内のテキストをRichEditに表示
//  DLLを使用するコードの例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDllHandle     : THandle;
  LExtractarFunc : TExtractTextFunc;
  LdocFilePath   : WideString;
  LOutText       : WideString;
begin
  //DLLをロード
  LDllHandle := LoadLibrary('xd2txlib.dll');
  if LDllHandle < HINSTANCE_ERROR then begin
    ShowMessage('xd2txlib.dll をフォルダ内に置いてください');
    exit;
  end;

  try
    //DLL内のExtractTextという関数のアドレスを取得
    @LExtractarFunc := GetProcAddress(LDllHandle, 'ExtractText');
    if @LExtractarFunc = nil then exit;

    if OpenDialog1.Execute() then begin
      OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);

      RichEdit1.Clear;
      RichEdit1.Update;
      LdocFilePath := OpenDialog1.FileName;

      //DLL内の関数を実行
      //PBSTR型の引数の結果を取得するには，文字列のアドレスを渡す(重要)
      LExtractarFunc(LdocFilePath, False, @LOutText);

      RichEdit1.Lines.Add(LOutText);
    end;
  finally
    FreeLibrary(LDllHandle);
  end;
end;

end.