// *********************************************
// ** Object for dual WordProcessing managing **
// ** using Word or OpenOffice automaticaly **
// ** By: Sergio Hernandez **
// ** oficina(at)hcsoft.net, CopyLeft 2004 **
// ** Version 0.3 20-10-2009 (DDMMYYYY) **
// ** Use it freely, change it, etc. **
// *********************************************
{EXAMPLE OF USE
//Create object: We have two flavours:
//(A) from an existing file...
TxtDoc:= TDocumentoTexto.create(OpenDialog.FileName, false);
//(B) from a blank document...
TxtDoc:= TDocumentoTexto.create(thcOpenOffice, true); //OpenOffice doc if possible, please
TxtDoc.FileName:= 'C:\MyNewDoc'; //Needs a file name before you SaveDoc!
//--end of creation.
//Change a text (search&replace)
TxtDoc.ChangeOneValue('<MyClient>', 'Cocoa company, ltd.');
//Preview print...
TxtDoc.ShowPrintPreview
TxtDoc.PrintDoc;
TxtDoc.SaveDoc;
TxtDoc.SaveToPDF('C:\MyPDF.pdf');
TxtDoc.Free;
}
{ABOUT CONVERTING DOC TO PDF:
//Force opening the .doc file with OOo like this:
TxtDoc:= TDocumentoTexto.create(thcOpenOffice, true);
TxtDoc.LoadDoc('C:\MyWord.doc');
//Now that OOo has imported the .doc, convert it:
TxtDoc.SaveToPDF('C:\MyPDF.pdf');
TxtDoc.Free;
}
{HISTORIY:
V0.3 - SaveToPDF for OpenOffice added from www.oooforum.org/forum/viewtopic.phtml?t=22344
V0.2 - WaitForIddle added to avoid Word behavior (saving before completing work)
V0.1 - Initial version, it works ok.
}
{TODO LIST:
-No functions to add text, change font, bold, etc.
-Can I know the OOo writer printing status like in Word?
-Can I know if Word/Writer is doing something in background?
}
unit UDocumentoTexto;
interface
uses Variants, SysUtils, ComObj, Classes, Launch;
//thcError: Tried to open but both failes
//thcNone: Haven't tried still to open
type TTipoDoc = (thcError, thcNone, thcWord, thcOpenOffice);
type TDocumentoTexto = class(TObject)
private
fVisible: boolean;
//Program loaded stuff...
procedure LoadProg;
procedure CloseProg;
function GetProgLoaded: boolean;
procedure NewDoc;
procedure LoadDoc;
procedure CloseDoc;
function GetDocLoaded: boolean;
function GetIsWord: boolean;
function GetIsOpenOffice: boolean;
procedure SetVisible(v: boolean);
//OpenOffice only stuff...
function FileName2URL(FileName: string): string;
procedure ooDispatch(ooCommand: string; ooParams: variant);
function ooCreateValue(ooName: string; ooData: variant): variant;
function isNullEmpty(thisVariant: Variant): Boolean;
public
Tipo: TTipoDoc; //Witch program was used to manage the doc?
FileName: string; //In windows FileName format C:\MyDoc.XXX
Programa: variant; //Word or OpenOfice instance created.
DeskTop: variant; //OpenOffice desktop reference (not used now).
Document: variant; //Document opened.
//Object internals...
constructor Create(Name: string; MakeVisible: boolean); overload;
constructor Create(MyTipo: TTipoDoc; MakeVisible: boolean); overload;
destructor Destroy; override;
//Program loaded stuff...
function SaveDoc: boolean;
function SaveToPDF(FileName: string): boolean;
function PrintDoc: boolean;
procedure ShowPrintPreview;
property ProgLoaded: boolean read GetProgLoaded;
property DocLoaded: boolean read GetDocLoaded;
property IsWord: boolean read GetIsWord;
property IsOpenOffice: boolean read GetIsOpenOffice;
property Visible: boolean read fVisible write SetVisible;
//Special function (Search & Replace)
procedure ChangeOneValue(SearchTxt, ReplaceTxt: String; Headers: boolean = true);
//Wait until word end doing its things
function WaitForIddle(MaxSec: double = 30): double;
end;
var
CoInitFlags: Integer = -1;
const
SearchAll: integer = 2; //Word search_for_all (0=None, 1=Once, 2=All)
implementation
// ************************
// ** Create and destroy **
// ************************
//Create with an empty doc of requested type (use thcWord, thcOpenOffice)
//Remember to define FileName before calling to SaveDoc
constructor TDocumentoTexto.Create(MyTipo: TTipoDoc; MakeVisible: boolean);
var
i: integer;
IsFirstTry: boolean;
begin
//Close all opened things first...
CloseDoc;
CloseProg;
//I will try to open twice, so if Word fails, OpenOffice is used instead
IsFirstTry:= true;
for i:= 1 to 2 do begin
//Try to open OpenOffice...
if (MyTipo = thcOpenOffice) or (MyTipo = thcNone)then begin
try
Programa:= CreateOleObject('com.sun.star.ServiceManager');
except
end;
if ProgLoaded then begin
Tipo:= thcOpenOffice;
break;
end else begin
if IsFirstTry then begin
//Try Excel as my second choice
MyTipo:= thcWord;
IsFirstTry:= false;
end else begin
//Both failed!
break;
end;
end;
end;
//Try to open Word...
if (MyTipo = thcWord) or (MyTipo = thcNone) then begin
try
Programa:= CreateOleObject('Word.Application');
except
end;
if ProgLoaded then begin
Tipo:= thcWord;
break;
end else begin
if IsFirstTry then begin
//Try OpenOffice as my second choice
MyTipo:= thcOpenOffice;
IsFirstTry:= false;
end else begin
//Both failed!
break;
end;
end;
end;
end;
//Was it able to open any of them?
if Tipo = thcNone then begin
Tipo:= thcError;
raise Exception.Create('TDocumentoTexto.create failed, may be no Office is installed?');
end;
//Add a blank document...
fVisible:= MakeVisible;
NewDoc;
end;
constructor TDocumentoTexto.Create(Name: string; MakeVisible: boolean);
begin
//Close all opened things first...
CloseDoc;
CloseProg;
Tipo:= thcNone;
//Store values...
FileName:= Name;
//Open program and document...
LoadProg;
LoadDoc;
//Visible?
Visible:= MakeVisible;
end;
destructor TDocumentoTexto.Destroy;
begin
CloseProg;
inherited;
end;
// *************************
// ** Loading the program **
// ** Word or OpenOffice **
// *************************
procedure TDocumentoTexto.LoadProg;
begin
if ProgLoaded then CloseProg;
if (UpperCase(ExtractFileExt(FileName))='.DOC') then begin
//Word is the primary choice...
try
Programa:= CreateOleObject('Word.Application');
except end;
if ProgLoaded then Tipo:= thcWord;
end;
//Not lucky with Word? Another filetype? Let's go with OpenOffice...
if Tipo = thcNone then begin
//Try with OpenOffice...
try
Programa:= CreateOleObject('com.sun.star.ServiceManager');
except end;
if ProgLoaded then Tipo:= thcOpenOffice;
end;
//Still no program loaded?
if not ProgLoaded then begin
Tipo:= thcError;
raise Exception.Create('TDocumentoTexto.LoadProg failed, may be no Office is installed?');
end;
end;
procedure TDocumentoTexto.CloseProg;
begin
if not Visible then CloseDoc;
if ProgLoaded then begin
try
if IsWord then begin
Programa.Quit;
Programa:= Null;
end;
if IsOpenOffice then begin
Desktop.Dispose;
Desktop:= unassigned;
Programa.Dispose;
end;
Programa:= Unassigned;
except end;
end;
Tipo:= thcNone;
end;
//Is there any prog loaded? Witch one?
function TDocumentoTexto.GetProgLoaded: boolean;
begin
result:= not isNullEmpty(Programa);
end;
function TDocumentoTexto.GetIsWord: boolean;
begin
result:= (Tipo=thcWord);
end;
function TDocumentoTexto.GetIsOpenOffice: boolean;
begin
result:= (Tipo=thcOpenOffice);
end;
// ************************
// ** Loading a document **
// ************************
procedure TDocumentoTexto.NewDoc;
var ooParams: variant;
begin
//Is the program running? (Word or OpenOffice)
if not ProgLoaded then raise Exception.Create('No program loaded for the new document.');
//Is there a doc already loaded?
CloseDoc;
DeskTop:= Unassigned;
//OK, now try to create the doc...
if IsWord then begin
Programa.WorkBooks.Add;
Programa.Visible:= Visible;
Document:= Programa.ActiveWorkBook;
end;
if IsOpenOffice then begin
Desktop:= Programa.CreateInstance('com.sun.star.frame.Desktop');
//Optional parameters (visible)...
ooParams:= VarArrayCreate([0, 0], varVariant);
ooParams[0]:= ooCreateValue('Hidden', false); // çç not Visible);
//Create the document...
Document:= Desktop.LoadComponentFromURL('private:factory/swriter', '_blank', 0, ooParams);
end;
end;
procedure TDocumentoTexto.LoadDoc;
var ooParams: variant;
begin
if FileName='' then exit;
//Is the program running? (Word or OpenOffice)
if not ProgLoaded then LoadProg;
//Is there a doc already loaded?
CloseDoc;
DeskTop:= Unassigned;
//OK, now try to open the doc...
if IsWord then begin
Document:= Programa.Documents.Open(string(FileName),,,,,,,,,,,true);
end;
if IsOpenOffice then begin
Desktop:= Programa.CreateInstance('com.sun.star.frame.Desktop');
//Optional parameters (visible)...
ooParams:= VarArrayCreate([0, 0], varVariant);
ooParams[0]:= ooCreateValue('Hidden', false); //Should be "not Visible" but didn't work ok
//Open the document...
Document:= Desktop.LoadComponentFromURL(FileName2URL(FileName), '_blank', 0, ooParams);
if isNullEmpty(Document) then
raise Exception.Create('Could load the document "'+FileName+'".');
end;
if Tipo=thcNone then
raise Exception.Create('Could load the document "'+FileName+'". No Word processor installed?.');
end;
function TDocumentoTexto.SaveDoc: boolean;
begin
result:= false;
if DocLoaded then begin
if IsWord then begin
Document.Save;
result:= true;
end;
if IsOpenOffice then begin
//There is another method, more powerfull, see SaveToPDF function.
Document.Store;
result:= true;
end;
end;
end;
//If you are using OOo, you can export to PDF directly.
//In word, the only choice is to use a PDF printer, out of our scope here!
//NOTE: If you open a HTML in OOo, the param 0 need to be diferent as commented
//Code refactored from an example by Ryan at:
// http://www.oooforum.org/forum/viewtopic.phtml?t=22344
function TDocumentoTexto.SaveToPDF(FileName: string): boolean;
var ooParams: variant;
begin
result:= false;
if DocLoaded then begin
if IsOpenOffice then begin //Word can't export to PDF!
ooParams:= VarArrayCreate([0, 0], varVariant);
//If the doc loaded is a HTML, you should use this param[0] instead:
//ooParam[0]:= ooCreateValue('FilterName', 'writer_web_pdf_Export')
ooParams[0]:= ooCreateValue('FilterName', 'writer_pdf_Export');
Document.StoreToURL(FileName2URL(FileName), ooParams);
end;
end;
end;
//Print the Doc...
function TDocumentoTexto.PrintDoc: boolean;
var ooParams: variant;
begin
result:= false;
if DocLoaded then begin
if IsWord then begin
Document.PrintOut;
while Programa.BackgroundPrintingStatus > 0 do
sleep(500);
result:= true;
end;
if IsOpenOffice then begin
ooParams:= VarArrayCreate([0, 0], varVariant);
ooParams[0]:= ooCreateValue('Wait', true);
Document.Print(ooParams);
//Can't know printing status (maybe it is possible)
//So wait for process to iddle (under 0.5% CPU)
WaitForIddle;
result:= true;
end;
end;
end;
procedure TDocumentoTexto.ShowPrintPreview;
begin
if DocLoaded then begin
//Force visibility of the doc...
Visible:= true;
if IsWord then
Document.PrintOut(,,,true);
if IsOpenOffice then
ooDispatch('.uno:PrintPreview', Unassigned);
end;
end;
procedure TDocumentoTexto.SetVisible(v: boolean);
begin
if DocLoaded and (v<>fVisible) then begin
if IsWord then
Programa.Visible:= v;
if IsOpenOffice then begin
Document.getCurrentController.getFrame.getContainerWindow.setVisible(v);
end;
fVisible:= v;
end;
end;
procedure TDocumentoTexto.CloseDoc;
begin
if DocLoaded then begin
//Close it...
try
if IsOpenOffice then Document.Dispose;
if IsWord then Document.close;
except end;
//Clean up "pointer"...
Document:= Null;
end;
end;
function TDocumentoTexto.GetDocLoaded: boolean;
begin
result:= not isNullEmpty(Document);
end;
procedure TDocumentoTexto.ChangeOneValue(SearchTxt, ReplaceTxt: String; Headers: boolean = true);
var j, Paso: integer;
Txt, Busca, Reemp: string;
ooBuscador: variant;
begin
case Tipo of
thcWord: begin
//Word can't replace with a text longer than 250!
if length(ReplaceTxt) < 250 then begin
Programa.ActiveDocument.Content.Find.Execute(SearchTxt, true, false, false, false, false,,,, ReplaceTxt, SearchAll);
if Headers then begin
//Search in page header...
Programa.ActiveWindow.ActivePane.View.SeekView:= 9; //9 = wdSeekCurrentPageHeader
Programa.Selection.Find.Execute(SearchTxt, true, false, false, false, false,,,,ReplaceTxt,SearchAll);
//Search on footer...
Programa.ActiveWindow.ActivePane.View.SeekView:= 10; //10 = wdSeekCurrentPageFooter
Programa.Selection.Find.Execute(SearchTxt, true, false, false, false, false,,,,ReplaceTxt,SearchAll);
end;
//You can wait for Word to finish 0.1 secs. uncomenting next line...
//sleep(100);
//...but calling WaitForIddle after all your replaces is a better choice!
end else begin
//I have to "chop" the text into pieces of max. 240 chars!
//NOTE: Coping from array N[] to D[] can make a DLL run out of memory
//and raise rare errors, so I make it char by char!
Busca:= ''; for j:= 1 to Length(SearchTxt) do Busca:= Busca+SearchTxt[j];
Reemp:= ''; for j:= 1 to Length(ReplaceTxt) do Reemp:= Reemp+ReplaceTxt[j];
Paso:= 1;
repeat
Txt:= copy(Reemp,1,240);
Reemp:= copy(Reemp,241,9999);
if (Reemp<>'') then
Txt:= Txt+'[@#@'+IntToStr(Paso)+']';
Programa.ActiveDocument.Content.Find.Execute(Busca,true,false,false,false,false,,,,Txt,SearchAll);
Busca:= '[@#@'+IntToStr(Paso)+']';
inc(Paso);
//Need to wait for Word to finish before processing the next txt piece
sleep(100);
until (Reemp='');
end;
end;
thcOpenOffice: begin
if isNullEmpty(Document) then
raise Exception.Create('No text document loaded');
ooBuscador:= Document.createReplaceDescriptor;
ooBuscador.SearchString:= SearchTxt;
ooBuscador.ReplaceString:= ReplaceTxt;
Document.ReplaceAll(ooBuscador);
end;
end;
end;
//Wait for Word to end up with all instruction we have through at it.
//As Word diggest them asincronous, you never know if you are finish
//and you can end up saving BEFORE all previous commands are done!
//It detects it by measuring the proc %CPU usage until it drops below 0.5%
function TDocumentoTexto.WaitForIddle(MaxSec: double = 30): double;
var ProcName: string;
begin
//Process Name...
if Tipo=thcWord then ProcName:= 'WINWORD.EXE'
else ProcName:= 'swriter.exe';
//Wait for the %CPU to drop below 0.5%
result:= WaitExeIddle(ProcName, 1, MaxSec);
end;
// ***************************
// ** OpenOffice only stuff **
// ***************************
//Change 'C:\File.txt' into 'file:///c:/File.txt' (for OpenOffice OpenURL)
function TDocumentoTexto.FileName2URL(FileName: string): string;
begin
result:= '';
if LowerCase(copy(FileName,1,8))<>'file:///' then
result:= 'file:///';
result:= result + StringReplace(FileName, '\', '/', [rfReplaceAll, rfIgnoreCase]);
end;
function TDocumentoTexto.ooCreateValue(ooName: string; ooData: variant): variant;
var
ooReflection: variant;
begin
if IsOpenOffice then begin
ooReflection:= Programa.createInstance('com.sun.star.reflection.CoreReflection');
ooReflection.forName('com.sun.star.beans.PropertyValue').createObject(result);
result.Name := ooName;
result.Value:= ooData;
end else begin
raise Exception.Create('ooValue imposible to create, load OpenOffice first!');
end;
end;
procedure TDocumentoTexto.ooDispatch(ooCommand: string; ooParams: variant);
var
ooDispatcher, ooFrame: variant;
begin
if DocLoaded and IsOpenOffice then begin
if (VarIsEmpty(ooParams) or VarIsNull(ooParams)) then
ooParams:= VarArrayCreate([0, -1], varVariant);
ooFrame:= Document.getCurrentController.getFrame;
ooDispatcher:= Programa.createInstance('com.sun.star.frame.DispatchHelper');
ooDispatcher.executeDispatch(ooFrame, ooCommand, '', 0, ooParams);
end else begin
raise Exception.Create('Dispatch imposible, load a OpenOffice doc first!');
end;
end;
function TDocumentoTexto.isNullEmpty(thisVariant: Variant): Boolean;
begin
Result:= VarIsEmpty(thisVariant) or VarIsNull(thisVariant) or VarIsClear(thisVariant);
end;
end.