MS-WORDの文書ファイルを読込んでテキスト表示するには？ (ID:15549)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

動作しないファイルがあった場合、暫く居つくので連絡ください。

function ExtractText(WordBlockStr: array of Byte):string;
var str:string;
    wstr:WideString;
    wchar:WideChar;
    i:integer;
    isUNICODE,isZero:boolean;
begin
  i:=0;
  isUNICODE:=False;
  isZero   :=False;
  //UNICODE判別
  repeat
    if WordBlockStr[i]>($7F) then
      isUNICODE:=True;
    if (WordBlockStr[i]=$00) and
       (WordBlockStr[i+1]<>$00) then
      isUNICODE:=True;
    if (WordBlockStr[i]=$00) and
       (WordBlockStr[i+1]=$00) then
      isZero:=True;
    inc(i);
  until (isUNICODE=True) or
        (isZero=True) or
        (i >= Length(WordBlockStr));

if isUNICODE=True then
  //UNICODEの場合
    begin
      wstr:='';
      //何らかの制御ブロック
      if (WordBlockStr[2]=$00) and
         (WordBlockStr[3]=$00) then
         begin
           Result:='';
           exit;
         end;
      for i:=0 to ((Length(WordBlockStr)-1) div 2) do
      begin
        wchar := WideChar(WordBlockStr[i*2]+WordBlockStr[i*2+1]*256);
        if wchar=WideChar($00) then
        begin
          Result:=WideCharToString(PWideChar(wstr));
          exit;
        end;
        if wchar<>WideChar($0D) then
          wstr:=wstr + wchar
          else
          wstr:=wstr + #13#10;
      end;
      Result:=WideCharToString(PWideChar(wstr));
  end else begin
  //ASCIIの場合
    str:='';
    for i:= 0 to Length(WordBlockStr)-1 do
    begin
      if WordBlockStr[i]=$00 then
      begin
        Result:=str;
        exit;
      end;
      if WordBlockStr[i]<>$0D then
        str:=str + Char(WordBlockStr[i])
        else
        str:=str + #13#10;
    end;
    Result:=str;
  end;
end;

function TForm1.LoadDoc8File(FileName: string):string;
var
  F: File;
  str  : string;
  W8Text: array [0..511] of Byte;  //Word文字列ブロック
  fcMin:Longword;                  //Word文字列開始
  fcMac:Longword;                  //Word文字列終了
  spos :Longword;
begin
  str:='';
  AssignFile(F, filename);
  Reset(F, 1);
  //FIB
    //fcMin
    Seek(F,$0218);
    BlockRead(F,fcMin,Sizeof(fcMin));
    //fcMac
    Seek(F,$021C);
    BlockRead(F,fcMac,Sizeof(fcMac));
  spos:= $0200 + fcMin;
  seek(F,spos);
  repeat
    BlockRead(F,W8Text,Sizeof(W8Text));
    str:=str + ExtractText(W8Text);
    spos:=spos + 512;
  until spos >= $0200 + fcMac;
  result:=str;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //確認
  Memo1.Text:= LoadDoc8File(Edit1.Text);
end;

←解決時は質問者本人がここをチェックしてください。

戻る