Итак.
Извлечение текста из документов MS Office без этого самого MS Officа. Используя только встроенные возможности Windows по разбору структурированный хранилищ.
Имею на руках документацию по сабжу http://www.microsoft.com/interop/docs/officebinaryformats.mspx, не совсем рабочий исходник разбирающий Word 97-2003 - иногда получается иногда нет.
Вот кусок кода. Этого я думаю достаточно будет.
| Код |
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComObj, ActiveX, ExtCtrls, AxCtrls, StrUtils;
...
procedure TForm1.Button1Click(Sender: TObject);
var
FileName, StreamName: WideString;
Storage: IStorage;
MainStream, TabStream: IStream;
cb: LongInt;
NewPos: Int64;
Flags: Word;
fcMin, fcMax, cppText, fcClx, fcSz, Size: Integer;
Tag : Byte;
i, PieceCount: Integer;
CharPos : array[0..2047] of Integer;
FilePos : array[0..2047, 0..1] of Integer;
PieceLen : Integer;
PieceUnicode : WideString;
PieceCP1252 : string;
Text : string;
f : TextFile;
en : IEnumStatStg;
ststg : TStatStg;
begin
if Open_dialog.Execute then
begin
FileName := Open_dialog.FileName;
OleCheck(StgOpenStorage(PWideChar(FileName), nil, STGM_READ or STGM_SHARE_DENY_WRITE, nil, 0, Storage));
Storage.EnumElements(0,nil,0, en);
while en.Next(1, ststg, 0) = S_OK do
if ststg.dwType = STGTY_STREAM then
begin
// ShowMessage(string(ststg.pwcsName));
end;
StreamName := 'WordDocument';
OleCheck(Storage.OpenStream(PWideChar(StreamName), nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, MainStream));
OleCheck(MainStream.Seek(10, STREAM_SEEK_SET, NewPos));
OleCheck(MainStream.Read(@Flags, SizeOf(Flags), @cb));
if (Flags and $200) = $200
then StreamName := '1Table'
else StreamName := '0Table';
OleCheck(Storage.OpenStream(PWideChar(StreamName), nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, TabStream));
OleCheck(MainStream.Seek(24, STREAM_SEEK_SET, NewPos));
OleCheck(MainStream.Read(@fcMin, SizeOf(fcMin), @cb));
OleCheck(MainStream.Read(@fcMax, SizeOf(fcMax), @cb));
OleCheck(MainStream.Seek(76, STREAM_SEEK_SET, NewPos));
OleCheck(MainStream.Read(@cppText, SizeOf(cppText), @cb));
OleCheck(MainStream.Seek(418, STREAM_SEEK_SET, NewPos));
OleCheck(MainStream.Read(@fcClx, SizeOf(fcClx), @cb));
OleCheck(MainStream.Read(@fcSz, SizeOf(fcSz), @cb));
// piece table
OleCheck(TabStream.Seek(fcClx, STREAM_SEEK_SET, NewPos));
OleCheck(TabStream.Read(@Tag, SizeOf(Tag), @cb));
while Tag = 1 do
begin
OleCheck(TabStream.Read(@Size, SizeOf(Size), @cb));
if Size > 0 then OleCheck(TabStream.Seek(Size, STREAM_SEEK_CUR, NewPos));
OleCheck(TabStream.Read(@Tag, SizeOf(Tag), @cb));
end;
if Tag <> 2 then raise Exception.Create('Piece table tag must have been = 2');
OleCheck(TabStream.Read(@Size, SizeOf(Size), @cb));
PieceCount := (Size - 4) div 12;
OleCheck(TabStream.Read(@CharPos, (PieceCount + 1) * 4, @cb));
OleCheck(TabStream.Seek(2, STREAM_SEEK_CUR, NewPos));
OleCheck(TabStream.Read(@FilePos, PieceCount * 8, @cb));
Text := '';
for i := 0 to PieceCount - 1 do
begin
PieceLen := CharPos[i + 1] - CharPos[i];
if (FilePos[i, 0] and (1 shl 30)) = (1 shl 30) then // CP1252
begin
OleCheck(MainStream.Seek((FilePos[i, 0] and not (1 shl 30)), STREAM_SEEK_SET, NewPos));
SetLength(PieceCP1252, PieceLen);
OleCheck(MainStream.Read(@PieceCP1252[1], PieceLen, @cb));
// TODO CP1252 -> ANSI conversion
Text := Text + PieceCP1252;
end
else
begin // Unicode (UTF-16LE)
OleCheck(MainStream.Seek(FilePos[i, 0], STREAM_SEEK_SET, NewPos));
SetLength(PieceUnicode, PieceLen);
OleCheck(MainStream.Read(@PieceUnicode[1], PieceLen * 2, @cb));
Text := Text + PieceUnicode;
end;
end;
//Text
AssignFile(f, 'd:\test.txt');
Rewrite(f);
Write(f, Text);
CloseFile(f);
Memo1.Lines.LoadFromFile('d:\test.txt');
end;
end;
|
Очень буду рад, если кто-нибудь поможет все это довести до нормального, рабочего состояния на большей части документов.
Извлекаемый текст еще потом требует обработки, но это уже решаемая проблема.
Ну и конечно же есть желание потом сделать то же для форматов xls и ppt.
Заранее спасибо. |