lazarus-ccr/components/fpspreadsheet/examples/other/hyperlinkdemo/collectlinks.lpr

{ This program seeks all spreadsheet hyperlinks in the file "source.xls" and
  adds the linked worksheet to a new workbook. }

program collectlinks;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, uriParser,
  fpstypes, fpspreadsheet, fpsUtils, fpsAllFormats
  { you can add units after this };

const
  srcFile = 'source.ods';
  destFile = 'result';

var
  srcWorkbook, destWorkbook, linkedWorkbook: TsWorkbook;
  sheet, linkedSheet, destSheet: TsWorksheet;
  cell: PCell;
  hyperlink: PsHyperlink;
  u: TURI;
  fn: String;  // Name of linked file
  bookmark: String;  // Bookmark of hyperlink
  sheetFormat: TsSpreadsheetFormat;
  sheetName: String;
  r, c: Cardinal;
  dir: String;

begin
  // Just for the demo: create the file "source.xls". It contains hyperlinks to
  // some of the "test" files created in the XXXXdemo projects
  Write('Creating source workbook...');
  dir := ExtractFilePath(ParamStr(0));

  srcWorkbook := TsWorkbook.Create;
  try
    sheet := srcWorkbook.AddWorksheet('Sheet');

    sheet.WriteText(0, 0, 'Link to biff8 test file');
    sheet.WriteHyperlink(0, 0, '../../read_write/excel8demo/test.xls#''My Worksheet 2''!A1');
    //sheet.WriteHyperlink(0, 0, '../excel8demo/test.xls#''Meu Relatório''!A1');

    sheet.WriteText(1, 0, 'Link to ods test file');
    sheet.WriteHyperlink(1, 0, '../../read_write/opendocdemo/test.ods');

    sheet.WriteText(2, 0, 'E-Mail Link');
    sheet.WriteHyperlink(2, 0, 'mailto:someone@mail.com;someoneelse@mail.com?Subject=This is a test');

    sheet.WriteText(3, 0, 'Web-Hyperlink');
    sheet.WriteHyperlink(3, 0, 'http://www.lazarus-ide.org/');

    sheet.WriteText(4, 0, 'File-Link (absolute path)');
    sheet.WriteHyperlink(4, 0, 'file:///'+ExpandFilename('../../../tests/testooxml_1899.xlsx'));
    // This creates the URI such as "file:///D:\Prog_Lazarus\svn\lazarus-ccr\components\fpspreadsheet\tests\testooxml_1899.xlsx"
    // but makes sure that the file exists on your system.

    sheet.WriteText(5, 0, 'Jump to A10');
    sheet.WriteHyperlink(5, 0, '#A10');

    sheet.WriteColWidth(0, 40, suChars);

    srcWorkbook.WriteToFile(dir + srcFile, true);
  finally
    srcWorkbook.Free;
  end;
  WriteLn('Done.');

  // Prepare destination workbook
  destWorkbook := nil;

  // Now open the source file and seek hyperlinks
  Write('Reading source workbook, sheet ');
  srcWorkbook := TsWorkbook.Create;
  try
    srcWorkbook.ReadFromFile(dir + srcFile);
    sheet := srcWorkbook.GetWorksheetByIndex(0);
    WriteLn(sheet.Name, '...');

    for cell in sheet.Cells do
    begin
      hyperlink := sheet.FindHyperlink(cell);
      if (hyperlink <> nil) then    // Ignore cells without hyperlink
      begin
        WriteLn;
        WriteLn('Cell ', GetCellString(cell^.Row, cell^.Col), ':');
        WriteLn('  Hyperlink "', hyperlink^.Target, '"');
        if (hyperlink^.Target[1] = '#') then
          WriteLn('  Ignoring internal hyperlink')
        else
        begin
          u := ParseURI(hyperlink^.Target);
          if u.Protocol = '' then begin
            Write('  Local file (relative path)');
            SplitHyperlink(hyperlink^.Target, fn, bookmark)
          end else
          if URIToFileName(hyperlink^.Target, fn) then
            Write('  File (absolute path)')
          else
          begin
            WriteLn('  Ignoring protocol "', u.Protocol, '"');
            continue;  // Ignore http, mailto etc.
          end;

          if not FileExists(fn) then
            WriteLn(' does not exist.')
          else
          if GetFormatFromFileName(fn, sheetFormat) then
          begin
            Write(' supported. ');
            // Create destination workbook if not yet done so far...
            if destWorkbook = nil then
              destWorkbook := TsWorkbook.Create;
            // Open linked workbook
            linkedworkbook := TsWorkbook.Create;
            try
              linkedworkbook.ReadFromFile(fn, sheetFormat);
              // Get linked worksheet
              if bookmark = '' then
                linkedSheet := linkedWorkbook.GetWorksheetByIndex(0)
              else
                if not linkedWorkbook.TryStrToCell(bookmark, linkedsheet, r, c)
                then begin
                  WriteLn('Failure finding linked worksheet.');
                  continue;
                end;
              // Copy linked worksheet to new sheet in destination workbook
              destSheet := destWorkbook.CopyWorksheetFrom(linkedSheet, true);
              // Create sheet name
              sheetName := ExtractFileName(fn) + '#' +linkedSheet.Name;
              destWorkbook.ValidWorksheetName(sheetName, true);
              destSheet.Name := sheetName;
              // Done
              WriteLn(' Copied.');
            finally
              linkedworkbook.Free;
            end;
          end;
        end;
      end;
    end;

    // Save destination workbook
    WriteLn;
    if destWorkbook <> nil then
    begin
      destworkbook.WriteToFile(dir + destFile+'.xls', true);
      destworkbook.WriteToFile(dir + destFile+'.xlsx', true);
      destworkbook.WriteToFile(dir + destFile+'.ods', true);
      WriteLn('All hyperlinks to spreadsheets are collected in files ' + destFile + '.*');
    end else
      WriteLn('No hyperlinks found.');

  finally
    // Clean up
    srcWorkbook.Free;
    if destWorkbook <> nil then destWorkbook.Free;
  end;

  if ParamCount = 0 then
  begin
    {$IFDEF MSWindows}
    WriteLn;
    WriteLn('Press ENTER to close...');
    ReadLn;
    {$ENDIF}
  end;

end.