
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@366 8e941d3f-bd1b-0410-a28a-d453659cc2b4
396 lines
10 KiB
ObjectPascal
396 lines
10 KiB
ObjectPascal
unit ViewDoc;
|
|
|
|
{
|
|
|
|
Unit of functions for viewing documents with a word processor.
|
|
|
|
Author: Phil Hess.
|
|
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
|
|
License: Modified LGPL. This means you can link your code to this
|
|
compiled unit (statically in a standalone executable or
|
|
dynamically in a library) without releasing your code. Only
|
|
changes to this unit need to be made publicly available.
|
|
|
|
}
|
|
|
|
interface
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE Delphi}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
SysUtils,
|
|
Classes,
|
|
{$IFDEF MSWINDOWS}
|
|
Windows,
|
|
Registry,
|
|
ShellApi;
|
|
{$ENDIF}
|
|
{$IFDEF DARWIN} {OS X}
|
|
BaseUnix,
|
|
Unix;
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
FileUtil,
|
|
Unix;
|
|
{$ENDIF}
|
|
|
|
type
|
|
TViewerOptions = set of (ovwUseAsTemplate, ovwAddToDeleteList);
|
|
|
|
function GetViewerCount : Integer;
|
|
|
|
function GetViewerName(Viewer : Integer) : string;
|
|
|
|
function ViewDocument(const FileName : string;
|
|
Viewer : Integer;
|
|
Options : TViewerOptions;
|
|
var ErrorMsg : string) : Boolean;
|
|
|
|
function DeleteViewedDocs : Boolean;
|
|
|
|
|
|
implementation
|
|
|
|
const
|
|
{$IFDEF MSWINDOWS}
|
|
MaxViewers = 3; {Number of supported word processors}
|
|
|
|
{Names of word processors}
|
|
ViewerName : array [1..MaxViewers] of string =
|
|
('Microsoft Word',
|
|
'OpenOffice',
|
|
'AbiWord');
|
|
|
|
{Executable files}
|
|
ViewerExe : array [1..MaxViewers] of string =
|
|
('WINWORD.EXE',
|
|
'SOFFICE.EXE',
|
|
'AbiWord.exe');
|
|
|
|
{Command line startup switches.
|
|
If non-blank, start word processor with a new document
|
|
based on the specified template. If blank, open document
|
|
read-only to force user to save under different name.}
|
|
ViewerSwitch : array [1..MaxViewers] of string =
|
|
('/t',
|
|
'-n ',
|
|
'');
|
|
|
|
ViewerRegKey : array [1..MaxViewers] of string =
|
|
('',
|
|
'',
|
|
'SOFTWARE\Classes\AbiSuite.AbiWord\shell\open\command');
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DARWIN} {OS X}
|
|
MaxViewers = 4;
|
|
|
|
ViewerName : array [1..MaxViewers] of string =
|
|
('Microsoft Word',
|
|
'Pages',
|
|
'NeoOffice',
|
|
'AbiWord');
|
|
|
|
{OS X Open command doesn't support passing switches to app}
|
|
ViewerSwitch : array [1..MaxViewers] of string =
|
|
('',
|
|
'',
|
|
'',
|
|
'');
|
|
|
|
MaxViewerFolders = 7;
|
|
|
|
ViewerFolders : array [1..MaxViewerFolders] of string =
|
|
('Microsoft Word',
|
|
'Microsoft Office 2004/Microsoft Word',
|
|
'Microsoft Office X/Microsoft Word',
|
|
'Pages.app',
|
|
'iWork ''06/Pages.app',
|
|
'NeoOffice.app',
|
|
'AbiWord.app');
|
|
{$ENDIF}
|
|
|
|
{$IFDEF LINUX}
|
|
MaxViewers = 2;
|
|
|
|
ViewerName : array [1..MaxViewers] of string =
|
|
('OpenOffice',
|
|
'AbiWord');
|
|
|
|
ViewerExe : array [1..MaxViewers] of string =
|
|
('soffice.bin',
|
|
'abiword');
|
|
|
|
ViewerSwitch : array [1..MaxViewers] of string =
|
|
('-n ',
|
|
'');
|
|
{$ENDIF}
|
|
|
|
|
|
var
|
|
DeleteList : TStringList; {List of files to delete when program exits;
|
|
object is created and destroyed in unit's
|
|
initialization and finalization sections}
|
|
|
|
|
|
function GetViewerCount : Integer;
|
|
{Return number of viewers defined.}
|
|
begin
|
|
Result := MaxViewers;
|
|
end;
|
|
|
|
|
|
function GetViewerName(Viewer : Integer) : string;
|
|
{Return viewer's name.}
|
|
begin
|
|
Result := ViewerName[Viewer];
|
|
end;
|
|
|
|
|
|
function LocateViewer(Viewer : Integer) : string;
|
|
{Return path to viewer's executable file,
|
|
or blank string if can't locate viewer.}
|
|
{$IFDEF MSWINDOWS}
|
|
var
|
|
Reg : TRegistry;
|
|
begin
|
|
Result := '';
|
|
{With Windows, installed programs usually have Registry entries
|
|
under the App Paths section, including complete path to program.}
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := HKEY_LOCAL_MACHINE;
|
|
if ViewerRegKey[Viewer] = '' then
|
|
begin
|
|
if Reg.OpenKeyReadOnly(
|
|
'\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\' +
|
|
ViewerExe[Viewer]) then
|
|
begin {Found key, so assume program is installed}
|
|
try
|
|
if Reg.ReadString('') <> '' then {Key has (Default) registry entry?}
|
|
Result := Reg.ReadString('');
|
|
except {Trap exception if registry entry does not contain a string}
|
|
end;
|
|
end;
|
|
end
|
|
else {Non-standard registry key}
|
|
begin
|
|
if Reg.OpenKeyReadOnly(ViewerRegKey[Viewer]) then
|
|
begin {Found key, so assume program is installed}
|
|
try
|
|
if Reg.ReadString('') <> '' then {Key as (Default) registry entry?}
|
|
begin
|
|
Result := Reg.ReadString('');
|
|
if Copy(Result, 1, 1) = '"' then {Strip first quoted item?}
|
|
Result := Copy(Result, 2, Pos('"', Copy(Result, 2, MaxInt))-1);
|
|
end;
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Reg.Free;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DARWIN} //TODO: Search for app like OS X LaunchServices does.
|
|
var
|
|
FolderIdx : Integer;
|
|
LocIdx : Integer;
|
|
PathPrefix : string;
|
|
begin
|
|
Result := '';
|
|
FolderIdx := 0;
|
|
while (FolderIdx < MaxViewerFolders) and (Result = '') do
|
|
begin
|
|
Inc(FolderIdx);
|
|
if Pos(LowerCase(ViewerName[Viewer]),
|
|
LowerCase(ViewerFolders[FolderIdx])) > 0 then
|
|
begin
|
|
LocIdx := 0;
|
|
while (LocIdx < 4) and (Result = '') do
|
|
begin
|
|
Inc(LocIdx);
|
|
case LocIdx of
|
|
1 : PathPrefix := '/Applications/';
|
|
2 : PathPrefix := '~/Applications/';
|
|
3 : PathPrefix := '~/Desktop/';
|
|
4 : PathPrefix := '~/'
|
|
end;
|
|
if FileExists(PathPrefix + ViewerFolders[FolderIdx]) then
|
|
Result := PathPrefix + ViewerFolders[FolderIdx];
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF LINUX}
|
|
begin
|
|
{Search path for specified file name, returning its
|
|
expanded file name that includes path to it.}
|
|
Result := SearchFileInPath(
|
|
ViewerExe[Viewer], '', GetEnvironmentVariable('PATH'),
|
|
PathSeparator, [sffDontSearchInBasePath]);
|
|
{$ENDIF}
|
|
end; {LocateViewer}
|
|
|
|
|
|
function LaunchViewer(const ProgPath : string;
|
|
const Params : string;
|
|
const DefaultDir : string) : Integer;
|
|
{Start viewer program with specified command line parameters
|
|
by shelling to it, returning shell's code.}
|
|
{$IFDEF MSWINDOWS}
|
|
var
|
|
ProgPathBuf : array [0..MAX_PATH] of Char;
|
|
ParamsBuf : array [0..MAX_PATH] of Char;
|
|
DefaultDirBuf : array [0..MAX_PATH] of Char;
|
|
begin
|
|
StrPCopy(ProgPathBuf, ProgPath);
|
|
StrPCopy(ParamsBuf, Params);
|
|
StrPCopy(DefaultDirBuf, DefaultDir);
|
|
Result := ShellExecute(0, nil, ProgPathBuf, ParamsBuf, DefaultDirBuf,
|
|
SW_SHOWNORMAL);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DARWIN}
|
|
begin
|
|
Result := Shell('Open -a ' + ProgPath + ' ' + Params);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF LINUX}
|
|
begin
|
|
Result := Shell(ProgPath + ' ' + Params);
|
|
{$ENDIF}
|
|
end; {LaunchViewer}
|
|
|
|
|
|
function ViewDocument(const FileName : string;
|
|
Viewer : Integer;
|
|
Options : TViewerOptions;
|
|
var ErrorMsg : string) : Boolean;
|
|
{View FileName with Viewer. If successful, return True; if
|
|
error, return False and error message in ErrorMsg.}
|
|
var
|
|
ProgPath : string;
|
|
Switches : string;
|
|
ShellStatus : Integer;
|
|
{$IFDEF DARWIN}
|
|
FileInfo : Stat;
|
|
{$ENDIF}
|
|
begin
|
|
Result := False;
|
|
ErrorMsg := 'Unexpected error';
|
|
|
|
if not FileExists(FileName) then
|
|
begin
|
|
ErrorMsg := 'File does not exist.';
|
|
Exit;
|
|
end;
|
|
|
|
if ovwAddToDeleteList in Options then
|
|
DeleteList.Add(FileName);
|
|
|
|
if Viewer = 0 then {Use first word processor found?}
|
|
begin
|
|
ProgPath := '';
|
|
while (Viewer < MaxViewers) and (ProgPath = '') do
|
|
begin
|
|
Inc(Viewer);
|
|
ProgPath := LocateViewer(Viewer);
|
|
end;
|
|
if ProgPath = '' then
|
|
begin
|
|
ErrorMsg := 'Unable to locate a word processor.';
|
|
Exit;
|
|
end;
|
|
end
|
|
else {Use specified word processor}
|
|
begin
|
|
ProgPath := LocateViewer(Viewer);
|
|
if ProgPath = '' then
|
|
begin
|
|
ErrorMsg := ViewerName[Viewer] + ' does not appear to be installed.';
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
Switches := '';
|
|
if ovwUseAsTemplate in Options then
|
|
begin
|
|
Switches := ViewerSwitch[Viewer];
|
|
if Switches = '' then {No "template" switch to pass?}
|
|
{Set file read-only so user has to save under different name}
|
|
{$IFDEF MSWINDOWS}
|
|
FileSetAttr(FileName, faReadOnly);
|
|
{$ELSE} {OS X and Linux}
|
|
begin
|
|
FpStat(FileName, FileInfo);
|
|
FpChmod(FileName, FileInfo.st_mode and ($FFFF XOR S_IWUSR));
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
ShellStatus := LaunchViewer('"' + ProgPath + '"',
|
|
Switches + '"' + FileName + '"', '');
|
|
{$IFDEF MSWINDOWS}
|
|
if ShellStatus <= 32 then {Windows shell error?}
|
|
{$ELSE}
|
|
if ShellStatus = 127 then {Unix shell error?}
|
|
{$ENDIF}
|
|
begin
|
|
ErrorMsg := 'Shell error ' + IntToStr(ShellStatus) +
|
|
' attempting to start ' + ViewerName[Viewer] + '.';
|
|
Exit;
|
|
end;
|
|
|
|
ErrorMsg := '';
|
|
Result := True;
|
|
end; {ViewDocument}
|
|
|
|
|
|
function DeleteViewedDocs : Boolean;
|
|
{Attempt to delete documents in deletion list, returning
|
|
True if all documents deleted or False if unable to
|
|
delete all documents.}
|
|
var
|
|
DocNum : Integer;
|
|
{$IFDEF DARWIN}
|
|
FileInfo : Stat;
|
|
{$ENDIF}
|
|
begin
|
|
Result := True;
|
|
for DocNum := DeleteList.Count - 1 downto 0 do
|
|
begin
|
|
if FileExists(DeleteList.Strings[DocNum]) then
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
if (FileGetAttr(DeleteList.Strings[DocNum]) and faReadOnly) <> 0 then
|
|
FileSetAttr(DeleteList.Strings[DocNum],
|
|
FileGetAttr(DeleteList.Strings[DocNum]) - faReadOnly);
|
|
{$ELSE} {OS X and Linux}
|
|
FpStat(DeleteList.Strings[DocNum], FileInfo);
|
|
if (FileInfo.st_Mode or S_IWUSR) = 0 then {File read-only?}
|
|
FpChmod(DeleteList.Strings[DocNum], FileInfo.st_Mode or S_IWUSR);
|
|
{$ENDIF}
|
|
if SysUtils.DeleteFile(DeleteList.Strings[DocNum]) then
|
|
DeleteList.Delete(DocNum)
|
|
else
|
|
Result := False; {At least one doc not deleted}
|
|
end;
|
|
end; {for DocNum}
|
|
end; {DeleteViewedDocs}
|
|
|
|
|
|
initialization
|
|
DeleteList := TStringList.Create;
|
|
|
|
finalization
|
|
DeleteViewedDocs;
|
|
DeleteList.Free;
|
|
|
|
end.
|
|
|