Новичок
Профиль
Группа: Участник
Сообщений: 7
Регистрация: 12.12.2005
Репутация: нет
Всего: нет
|
Итак. Извлечение текста из документов MS Office без этого самого MS Officа. Используя только встроенные возможности Windows по разбору структурированный хранилищ. Имею на руках документацию по сабжу Microsoft Office Binary (doc, xls, ppt) File Formats, не совсем рабочий исходник разбирающий 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. Заранее спасибо. |
Извлечение текста из документов MS Office 
Загрузка ...
