unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ToolWin, MSWord, MSWPD, MSWBase, MSWRI, Menus,
  MSWOO, MSWFB2, SMWPDF, ImgList, System.ImageList;

type
  TfrmMain = class(TForm)
    OpenDialog: TOpenDialog;
    MSWordDocument1: TMSWordDocument;
    tbMain: TToolBar;
    btnOpen: TToolButton;
    ImageList: TImageList;
    btnStatistic: TToolButton;
    btnSeparator1: TToolButton;
    btnClose: TToolButton;
    btnAbout: TToolButton;
    btnOrder: TToolButton;
    btnSeparator2: TToolButton;
    pcDocument: TPageControl;
    tsPlainText: TTabSheet;
    memoDocument: TMemo;
    tsMacros: TTabSheet;
    memoMacros: TMemo;
    WordPerfectFile1: TWordPerfectFile;
    WRIFile1: TWRIFile;
    OpenOfficeTextDocument1: TOpenOfficeTextDocument;
    OpenOfficePresentation1: TOpenOfficePresentation;
    OpenOfficeSpreadsheet1: TOpenOfficeSpreadsheet;
    procedure btnOpenClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnOrderClick(Sender: TObject);
    procedure btnStatisticClick(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
    procedure MSWordDocument1ConvertSysChar(Sender: TObject;
      SysChar: TSMWordSysChar; Value: WideString; var Result: WideString);
  private
    { Private declarations }
    procedure ShowSummaryInfo(wd: TMSCustomWordDocument);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}
{$R winxp.res}

uses ShellAPI, SumInfo;

function GetPlain(lst: TWideStrings): WideString;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to lst.Count-1 do
    Result := Result + lst[i]
end;

procedure TfrmMain.btnOpenClick(Sender: TObject);
var
  strExt: string;
//  StartTick, EndTick: Integer;
begin
  if OpenDialog.Execute then
  begin
    strExt := UpperCase(ExtractFileExt(OpenDialog.FileName));
    if (strExt = '.WPD') then
    begin
      WordPerfectFile1.FileName := OpenDialog.FileName;
      WordPerfectFile1.Execute;

      memoDocument.Lines.Text := WordPerfectFile1.PlainText.Text;
    end
    else
    if (strExt = '.WRI') then
    begin
      WRIFile1.FileName := OpenDialog.FileName;
      WRIFile1.Execute;

      memoDocument.Lines.Text := WRIFile1.PlainText.Text;
    end
    else
    if (strExt = '.DOCX') then
    begin
      with TMSWordXDocument.Create(Self) do
        try
          FileName := OpenDialog.FileName;
//          TextFormating := tfHTML;
          
          Execute;

          memoDocument.Lines.Text := PlainText.Text;
        finally
          Free
        end
    end
    else
    if (strExt = '.ODT') then
    begin
      OpenOfficeTextDocument1.FileName := OpenDialog.FileName;
      OpenOfficeTextDocument1.Execute;

      memoDocument.Lines.Text := OpenOfficeTextDocument1.PlainText.Text;
    end
    else
    if (strExt = '.ODP') then
    begin
      OpenOfficePresentation1.FileName := OpenDialog.FileName;
      OpenOfficePresentation1.Execute;

      memoDocument.Lines.Text := OpenOfficePresentation1.PlainText.Text;
    end
    else
    if (strExt = '.ODS') then
    begin
      OpenOfficeSpreadsheet1.FileName := OpenDialog.FileName;
      OpenOfficeSpreadsheet1.Execute;

      memoDocument.Lines.Text := OpenOfficeSpreadsheet1.PlainText.Text;
    end
    else
    if (strExt = '.FB2') then
    begin
      with TFictionBook.Create(Self) do
        try
          FileName := OpenDialog.FileName;
//          TextFormating := tfHTML;
          
          Execute;

          memoDocument.Lines.Text := PlainText.Text;
        finally
          Free
        end
    end
    else
    if (strExt = '.PDF') then
    begin
      with TSMPDFReader.Create(Self) do
        try
          FileName := OpenDialog.FileName;
          
          Execute;

          memoDocument.Lines.Text := PlainText.Text;
        finally
          Free
        end
    end
    else
    begin
      MSWordDocument1.ParseItems := MSWordDocument1.ParseItems - [wpiVBA];
      MSWordDocument1.FileName := OpenDialog.FileName;

//      StartTick := GetTickCount;
      MSWordDocument1.Execute;
//      EndTick := GetTickCount;
//      Caption := IntToStr(EndTick - StartTick + 1) + ' msec';

      memoDocument.Lines.Text := GetPlain(MSWordDocument1.PlainText);//MSWordDocument1.PlainText.Text;
      memoMacros.Lines.Text := MSWordDocument1.MacroText.Text;
    end;
    btnStatistic.Enabled := True
  end;
end;

function DT2Str(dt: TDateTime): string;
begin
  if dt = 0 then
    Result := ''
  else
    Result := DateToStr(dt)
end;

procedure TfrmMain.ShowSummaryInfo(wd: TMSCustomWordDocument);
begin
  with TfrmSummaryInfo.Create(Application) do
    try
      with lvSummary.Items.Add do
      begin
        Caption := 'FileName';
        SubItems.Add(wd.FileName)
      end;

      with lvSummary.Items.Add do
      begin
        Caption := 'Title';
        SubItems.Add(wd.SummaryInformation.Title)
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'Subject';
        SubItems.Add(wd.SummaryInformation.Subject)
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'Author';
        SubItems.Add(wd.SummaryInformation.Author)
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'Application';
        SubItems.Add(wd.SummaryInformation.AppName)
      end;

      with lvSummary.Items.Add do
      begin
        Caption := 'Keywords';
        SubItems.Add(wd.SummaryInformation.Keywords)
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'Comments';
        SubItems.Add(wd.SummaryInformation.Comments)
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'Template';
        SubItems.Add(wd.SummaryInformation.Template)
      end;

      with lvSummary.Items.Add do
      begin
        Caption := 'LastAuthor';
        SubItems.Add(wd.SummaryInformation.LastAuthor)
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'Created';
        SubItems.Add(DT2Str(wd.SummaryInformation.Created))
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'LastSaved';
        SubItems.Add(DT2Str(wd.SummaryInformation.LastSaved))
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'LastPrinted';
        SubItems.Add(DT2Str(wd.SummaryInformation.LastPrinted))
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'RevNumber';
        SubItems.Add(wd.SummaryInformation.RevNumber)
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'EditTime (min)';
        SubItems.Add(IntToStr(wd.SummaryInformation.EditTime))
      end;

      with lvSummary.Items.Add do
      begin
        Caption := 'PageCount';
        SubItems.Add(IntToStr(wd.SummaryInformation.PageCount))
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'CharCount';
        SubItems.Add(IntToStr(wd.SummaryInformation.CharCount))
      end;
      with lvSummary.Items.Add do
      begin
        Caption := 'WordCount';
        SubItems.Add(IntToStr(wd.SummaryInformation.WordCount))
      end;

      ShowModal
    finally
      Free
    end;
end;

procedure TfrmMain.btnStatisticClick(Sender: TObject);
begin
  ShowSummaryInfo(MSWordDocument1)
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
  Close
end;

procedure TfrmMain.btnOrderClick(Sender: TObject);
begin
  ShellExecute(0, 'open', 'http://www.scalabium.com/smorder.htm', nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.btnAboutClick(Sender: TObject);
begin
  Application.MessageBox('TMSWordDocument component, written by Scalabium Software'#13#10 +
                         ''#13#10 +
                         'Allow to read documents created in MS Word without MS Word installed'#13#10 +
                         'Direct and native document processing allow to extract a text very-very fast'#13#10 +
                         ''#13#10 +
                         'For additional tech information or support ask Mike Shkolnik:' + #13#10 +
                         'http://www.scalabium.com, e-mail: mshkolnik@scalabium.com' + #13#10#13#10 +
                         'You can order a product at:  http://www.scalabium.com/smorder.htm'#13#10,
                         'About TMSWordDocument v1.31', MB_OK);
end;

procedure TfrmMain.MSWordDocument1ConvertSysChar(Sender: TObject;
  SysChar: TSMWordSysChar; Value: WideString; var Result: WideString);
var
  i: Integer;
begin
  if (SysChar = scColumnEnd) then
    Result := Result + #13#10//#9
  else
  if (SysChar in [scRowEnd]) then
    Result := Result + #13#10
  else
  if (SysChar in [scHyperlink, scIncludePicture]) then
  begin
    {remove url, leave text only}
    i := Pos(#$14, Result);
    if (i > 0) then
      Delete(Result, 1, i)

    {to leave the url+text, use the next code instead:
{    i := Pos(#$14, Result);
    if (i > 0) then
      Result[i] := ' '
}
  end
  else
  if (SysChar = scFieldEnd) then
  begin
    {remove url, leave text only}
    i := Pos(#$14, Result);
    if (i > 0) then
      Delete(Result, 1, i)
  end
  else
  if (SysChar = scEndOfPage) then
  begin
    Result := '---------------------------------------------------'#13#10
  end
end;

end.
