22 respuestas en este tema

[santiago14]

Bueno, el título es autoexplicativo.
¿Cómo hago para convertir un .doc que tengo en un directorio a un .pdf?
Lo quiero de manera nativa, los clientes no quieren usar pdfcreator o parecidos.
¿Algún código que resuelva el problema?

Gracias.
______________

[egostar]

A reserva de que alguien por aquí haya tenido que desarrollar algo para ello, hay componentes que lo hacen, y sí, ya lo habrás intuido, es de pago

Ahí mismo verás componentes para delphi

Saludos

[Caral]

Hola
Esto:

delphi

uses
  OleAuto;
const
  wdExportFormatPDF = 17;
var 
  Word, Doc: OleVariant;
begin
  Word := CreateOLEObject('Word.Application');
  Doc := Word.Documents.Open('C:\Document.docx');
  Doc.ExportAsFixedFormat('C:\Document.pdf', wdExportFormatPDF);
end;

Lo vi aqui: http://stackoverflow...ng-word-activex
Saludos
PD: Etiquetas delphi 

[santiago14]

Hola
Esto:

delphi

uses
  OleAuto;
const
  wdExportFormatPDF = 17;
var 
  Word, Doc: OleVariant;
begin
  Word := CreateOLEObject('Word.Application');
  Doc := Word.Documents.Open('C:\Document.docx');
  Doc.ExportAsFixedFormat('C:\Document.pdf', wdExportFormatPDF);
end;

Lo vi aqui: http://stackoverflow...ng-word-activex
Saludos
PD: Etiquetas delphi 

He probado con esta opción y me sale el siguiente error:

"La exportación produjo un error porque esta característica no está instalada"

Lo he probado en W8, 64bits, D7.
También lo he hecho en WXP, 32bits, D7.

En ambos casos me dió el mismo error.
El archivo que usé era .doc y no .docx

¿Cómo arreglo el dilema? La verdad es que está buena la forma de exportación. Tengo instalado Office 2007 en W8 y Office 2003 en WXP.

[santiago14]

Con un archivo .docx me muestra el mismo error.

[egostar]

Hola

Y no será que intentas crearlos en la raíz de "C", ¿ porque no lo agregas en un directorio personal ? Yo usé el disco "F" de mi máquina y funciona sin problemas.

Saludos

[santiago14]

Resulta que para que el código funcione bien hay que tener algunas cosas en cuenta:

1) Tener instalada alguna versiónd de Office. En mi caso, tengo Office 2007.
2) Esa instalación debe tener el complemento que le permite a Word salvar archivos como pdf. Eso se consigue en la página de Microsoft.

Con estas dos cositas en su lugar, todo va bien.
Ahora si hace la exportación como lo queremos.

Gracias.

[Sergio]

Otra pción es tener instalado OpenOffice o LibreOffice, ambos tienen filtros para exportar a PDF de fábrica, aunque el resultado es el mismo que con MS-Office.

Por cierto, creo que este sistema solo funciona a partir de Office 2007, los anteriores creo que no tenían este filtro de exportación, o al menos no de fábrica leí por algún sitio.

[santiago14]

Es verdad, hay que instalar el complemento por aparte.

Santiago.

[santiago14]

Otra pción es tener instalado OpenOffice o LibreOffice, ambos tienen filtros para exportar a PDF de fábrica, aunque el resultado es el mismo que con MS-Office.

Esto es bueno saberlo, no todos quieren comprar una licencia de Office solamente para poder hacer una exportación desde Delphi de sus archivos .doc o .docx

[santiago14]

Otra pción es tener instalado OpenOffice o LibreOffice, ambos tienen filtros para exportar a PDF de fábrica, aunque el resultado es el mismo que con MS-Office.

¿Cómo hago para llamar al "Word" (Creo que es Write) de LibreOffice?
Para llamar a Word se hace:

delphi

Word := CreateOLEObject('Word.Application');

Gracias.

[Sergio]

Mira el código "dual" para manejar word o write que puse aquí: http://www.delphiacc...84036/#msg84036

Creo que no incluye el código para exportar a PDF, pero bueno, si acaso eso lo tengo en otra unit que maneja hojas de cálculo: https://github.com/s...hi-SpreadSheets

En ese código tienes la forma de exportar el documento actual de libreoffice a PDF, la funcion en write debería ser idéntica a esta de Calc.

[santiago14]

Tal vez Uds. sepan que es esto:
En mi máquina pude exportar bien. Pero en otra PC, WXP, D7 salió el siguiente error:

Method 'ExportAsFixedFormat' not supported by automation object.


P/D: Voy a analizar bien lo que mandaste Sergio, la verdad es que está bien interesante.

Santiago.

[santiago14]

Mira el código "dual" para manejar word o write que puse aquí: http://www.delphiacc...84036/#msg84036

Creo que no incluye el código para exportar a PDF, pero bueno, si acaso eso lo tengo en otra unit que maneja hojas de cálculo: https://github.com/s...hi-SpreadSheets

En ese código tienes la forma de exportar el documento actual de libreoffice a PDF, la funcion en write debería ser idéntica a esta de Calc.

Sergio, estoy intentando compilar la unit uDocumentoTexto que pasaste en uno de los links pero me dice que no puede ubicar a la unit: "Launch"
¿Dónde la consigo?

Santiago.

[Sergio]

Tal vez Uds. sepan que es esto:
En mi máquina pude exportar bien. Pero en otra PC, WXP, D7 salió el siguiente error:

Method 'ExportAsFixedFormat' not supported by automation object.


P/D: Voy a analizar bien lo que mandaste Sergio, la verdad es que está bien interesante.

Santiago.

La version de Excel creo que va a ser, la función está a partir de Excel2007 (confirmado en msn).

[santiago14]

Sergio, cuando quiero compilar me indica que no tengo la unit "Launch". ¿Dónde la consigo?
Pongo el código de la clase que indicas:

delphi

// *********************************************
// ** 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.

El problema es aquí:

delphi

//...
unit UDocumentoTexto;
 
interface
 
uses Variants, SysUtils, ComObj, Classes, Launch;
 
//...

Gracias nuevamente.
Santiago.

[santiago14]

La encontré:
Está en: http://www.daniweb.c...execute-to-work

Pongo el código para los que no quieren irse "tan lejos":

delphi

{************************************************************************}
{*                                                                      *}
{*      file       : Launch.PAS                                         *}
{*                                                                      *}
{*      type       : unit                                               *}
{*                                                                      *}
{*      location   : \QUIRT\SRC\DELPHI                                  *}
{*                                                                      *}
{*      purpose    : Launch external programs                           *}
{*                                                                      *}
{*      author     : Lennert Ploeger (NKI / AVL)                        *}
{*                                                                      *}
{*      date       : 19980325                                           *}
{*                                                                      *}
{*      portability: 32 bit delphi only (V2.0 up)                       *}
{*                                                                      *}
{*      notes      : None                                               *}
{*                                                                      *}
{************************************************************************}
{* Updates:
When            Who     What
19980325        lsp     Created
19980331        lsp     Search for programs in PATH using SearchPath()
19980609        lsp     Allow white-spaces for the program to launch
19980709        lsp     Allow 'prog' to be empty in StartProgram
19980731        lsp     Enclose both file and directory names in double quotes
19980901        lsp     Removed some obsolete functions
19981004        mvh     Added RunProgram (waits until ready)
19981005        mvh     Renamed to RunProgramBlocking (waits until ready)
19981020        lsp     Program launched in RunProgramBlocking() is started
                        minimized and not given focus
19990110        mvh     RunProgramBlocking returns value
19990111        lsp     Fixed comment about CloseHandle()
19990112       	mvh	    Added RunProgramWaiting, shortened code by reuse
19990425        lsp     FileUtil -> QFileUtil
19990609        lsp     Removed QFileUtil dependency
*}
unit Launch;
interface
//Para pasar de ProcId a THandle
type
  TWindowRec = record
    Handle: THandle;
    ProcessId: Cardinal;
    WindowName: PChar;
  end;
  PWindowRec = ^TWindowRec;
function LocateProgramInSearchPath(ProgramName: string): string;
procedure StartProgram(prog, workdir: string; params: array of string);
function RunProgramBlocking(prog, workdir: string; params: array of string): integer;
function RunFileBlocking(fichero: string): boolean;
function RunProgramWaiting(prog, workdir: string; params: array of string): integer;
function ProgramStarter(prog, workdir: string; params: array of string; showmode: integer): integer;
//HCSoft...
//Localizar Handler de un proceso a partir del filename del ejecutable
function GetProcHandle(ExeFileName: string): THandle;
//Hacer cosas a partir del THandle...
function KillProc(H: THandle): boolean;
function WaitProcIddle(H: THandle; MinSeg: double = 1; MaxSeg: double = 30): double;
//Hacer cosas a partir del FileName...
function WaitExeIddle(ExeFileName: string; MinSeg: double = 0.1; MaxSeg: double = 10): double;
function KillTask(ExeFileName: string): boolean;
implementation
uses
  SysUtils, Dialogs, Windows, Forms, FileCtrl, ShellAPI, HCBase, Tlhelp32;
  
// Routine to retrieve file information using a file/dirname
function FileDirNameWin32FindData(FullPathName: string; var Win32FindData: TWin32FindData): boolean;
var
  Handle: THandle;
begin
  Handle := FindFirstFile(PChar(FullPathName), Win32FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    Result := True;
  end
  else
    Result := False;
end;
// Search for 'ProgramName' in %PATH% using Win API function 'SearchPath'
function LocateProgramInSearchPath(ProgramName: string): string;
type
  BufType = array[0..255] of char;
var
  SPPath: BufType;
  PathPtr: PChar;
begin
  if SearchPath(nil, PChar(ProgramName), nil, 255, SPPath, PathPtr)>0 then
    Result := StrPas(SPPath)
  else
    Result := ProgramName;
end;
function TestExistence(const Name: string): boolean;
begin
  Result := FileExists(Name) or DirectoryExists(Name);
end;
// Internal common code for the 3 exported program starters
function ProgramStarter(prog, workdir: string;
                        params: array of string; showmode: integer): integer;
var
  StartInf : TStartupInfo;
  ProcInf  : TProcessInformation;
  args     : string;
  progtmp  : string;
  pAppName : PChar;
  pworkdir : PChar;
  i        : integer;
begin
  // It appears that it is also possible to call ShellExecute, what seems
  // to be a bit a higher level function:
  // ShellExecute(handle, "open", path_to_file, NULL, NULL, SW_SHOWNORMAL);
  // Another alternative can be calling WinExec, but with the drawback of
  // not having the possibility to specify the work directory.
  ZeroMemory(@StartInf, sizeof(TStartupInfo));
  ZeroMemory(@ProcInf, sizeof(TProcessInformation));
  StartInf.cb      := sizeof(TStartupInfo);
  StartInf.dwFlags := STARTF_USESHOWWINDOW ;
  StartInf.wShowWindow := showmode;
  // To call CreateProcess() we should be carefull to enclose files
  // passed in 'lpCommandLine' in double quotes ('"') to make sure that
  // it understands where one starts and ends. The pecularity is that the
  // name of the executable should NOT be enclosed in double quotes. Passing
  // both the file and the arguments in lpCommandLine and leaving
  // lpApplicationName empty is no option, since the application and
  // arguments should be white-space delimited that way.
  progtmp := prog;
  if not FileExists(progtmp) then
    progtmp := LocateProgramInSearchPath(progtmp);
  if Length(prog)>0 then
    args := '"' + prog + '"';
  for i:=low(params) to high(params) do
  begin
    // Enclose file and directory names in double quotes to get them seperated properly
    if TestExistence(params[i]) then
    begin
      if Length(args)>0 then // Try to add spaces only when necessary
        args := args + ' "' + params[i] + '"'
      else
        args := '"' + params[i] + '"'
    end
    else if Length(params[i])>0 then
    begin
      if Length(args)>0 then // Try to add spaces only when necessary
        args := args + ' ' + params[i]
      else
        args := params[i];
    end;
  end;
  if Length(workdir)>0 then
    pworkdir := PChar(workdir)
  else
    pworkdir := nil;
  if Length(progtmp)>0 then
    pAppName := PChar(progtmp)
  else
    pAppName := nil;
  if not CreateProcess(pAppName, PChar(args), nil, nil, False, 0, nil,
    pworkdir, StartInf, ProcInf) then
    MessageDlg('El programa ' + prog + ' no ha podido ser ejecutado', mtError, [mbOk], 0);
  // The handles for both the process and the main thread must be closed through
  // calls to CloseHandle. These handles are not needed, so it is best to close
  // them immediately after the process is created.
  result := ProcInf.hProcess;
  CloseHandle(ProcInf.hThread);
end;
// routine to start program 'prog' using the file-parameters in 'params'.
// Be carefull with passing [] for the params, since the stackpointer seems
// to get corrupt. However, starting a program with no arguments can be done
// using StartProgram(program, workdir, [ ' ' ]).
procedure StartProgram(prog, workdir: string; params: array of string);
var
  hProcess: integer;
begin
  hProcess := ProgramStarter(prog, workdir, params, SW_SHOWDEFAULT);
  CloseHandle(hProcess);
end;
// routine to run program 'prog' using the file-parameters in 'params'.
// and wait until it is finished
// Be careful with passing [] for the params, since the stackpointer seems
// to get corrupt. However, starting a program with no arguments can be done
// using StartProgram(program, workdir, [ ' ' ]).
function RunProgramBlocking(prog, workdir: string; params: array of string): integer;
var
  hProcess: integer;
  j       : Cardinal;
begin
  hProcess := ProgramStarter(prog, workdir, params, SW_SHOWMINNOACTIVE);
  WaitForSingleObject(hProcess, INFINITE);
  GetExitCodeProcess(hProcess, j);
  result := integer(j);
  CloseHandle(hProcess);
end;
function RunFileBlocking(fichero: string): boolean;
var
  SEI: TShellExecuteInfo;
begin
  //Ejecuto el fichero con el programa adecuado...
  FillChar(SEI, SizeOf(SEI), 0); // Wipe the record to start with
  Result:= true;
  with SEI do
  begin
    cbSize := SizeOf(SEI);
    fMask := see_Mask_NoCloseProcess;
    Wnd := Application.MainForm.Handle;
    lpVerb := 'open';
    lpFile := PAnsiChar(fichero);
    lpDirectory := PChar(ExtractFilePath(fichero));
    nShow := sw_ShowNormal;
    if not ShellExecuteEx(@SEI) then
      Result:= False;
  end;
  //Espero a que liberen el fichero...
  //WaitForSingleObjet no se debe usar si se va a abrir una ventana porque
  //el proceso que llama deja de procesar mensajes y la ventana nueva cuelga:
  //http://msdn.microsoft.com/en-us/library/ms687032%28VS.85%29.aspx
  while WaitForSingleObject(SEI.hProcess, 100) = WAIT_TIMEOUT do
    Application.ProcessMessages;
end;
// routine to run program 'prog' using the file-parameters in 'params'.
// and wait until it is finished. During the wait, however, messages are
// processed so that the user interface remains 'live'.
function RunProgramWaiting(prog, workdir: string; params: array of string): integer;
var
  hProcess: integer;
  j        : Cardinal;
begin
  hProcess := ProgramStarter(prog, workdir, params, SW_SHOWMINNOACTIVE);
  while WaitForSingleObject(hProcess, 10) = WAIT_TIMEOUT do
    Application.ProcessMessages;
  GetExitCodeProcess(hProcess, j);
  result := integer(j);
  CloseHandle(hProcess);
end;
// **************************************************************************
// ** AÑADIDO SERGIO PARA MENEJAR PROCESOS POR SU HANDLE O SU EXE FILENAME **
// **************************************************************************
function FileTime2Milliseconds(FileTime: TFileTime): integer;
var ST: TSystemTime;
begin
  FileTimeToSystemTime(FileTime, ST);
  result:= ST.wMilliseconds + 1000 *
          (ST.wSecond + 60 * (ST.wMinute + 60 * ST.wHour)) ;
end;
//Sabemos 'WINWORD.EXE', dame un THandle del proceso para hacerle putadillas
function GetProcHandle(ExeFileName: string): THandle;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  result:= 0;
  FSnapshotHandle:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize:= Sizeof(FProcessEntry32);
  ContinueLoop:= Process32First(FSnapshotHandle, FProcessEntry32);
  while integer(ContinueLoop) <> 0 do begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
     or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then begin
      result:= OpenProcess(PROCESS_ALL_ACCESS, FALSE, FProcessEntry32.th32ProcessID);
      break;
    end;
    ContinueLoop:= Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;
//Mata este proceso!
function KillProc(H: THandle): boolean;
const PROCESS_TERMINATE=$0001;
begin
  result:= (Integer(TerminateProcess(H, 0))<>0);
end;
//Espera a que un Proceso use menos del 1% de la CPU.
//Si no encuentra el proceso, esperara MinSeg, y si lo encuentra pero no baja
//del 1%, se esperara un maximo de MaxSeg.
function WaitProcIddle(H: THandle; MinSeg: double = 1; MaxSeg: double = 30): double;
var
  LastProcTime, NewProcTime, UsedTime: integer; //Milisegundos todo
  CreaTime, ExitTime, UserTime, KernelTime: TFileTime;
const
  WAIT_FOR_MS: integer = 1000; //Cada 1 segundo (1000 ms) vuelves a mirar
  IDDLE_LOWER: integer =    5; //Usados < 5 ms = (%CPU<0.5) salimos
begin
  //Llevo esperando 0 segundos...
  result:= 0;
  //Igual no lo encuentro...
  if (H=0) then begin
    //Pues no esta, espero algo y me voy...
    sleep(round(MinSeg*1000));
  end else begin
    //Proceso encontrado, a esperar...
    if GetProcessTimes(H, CreaTime, ExitTime, KernelTime, UserTime)=BOOL(0) then exit;
    LastProcTime:= FileTime2Milliseconds(KernelTime) + FileTime2Milliseconds(UserTime);
    //Cada decima de segundo, recalculo...
    repeat
      sleep(WAIT_FOR_MS);
      result:= result + (WAIT_FOR_MS/1000);
      //Rescato tiempo dle proceso actualizado...
      if GetProcessTimes(H, CreaTime, ExitTime, KernelTime, UserTime)=BOOL(0) then exit;
      NewProcTime:= FileTime2Milliseconds(KernelTime) + FileTime2Milliseconds(UserTime);
      UsedTime:= (NewProcTime - LastProcTime);
      if (UsedTime) < IDDLE_LOWER then
        break;
      LastProcTime:= NewProcTime;
    until (result >= MaxSeg);
  end;
end;
// ***************************************************
// ** MANEJO PROCESOS SABIENDO SU NOMBRE DE FICHERO **
// ***************************************************
//Espera a que una tarea baje del 1%CPU usando su filename
function WaitExeIddle(ExeFileName: string; MinSeg: double = 0.1; MaxSeg: double = 10): double;
begin
  result:= WaitProcIddle(GetProcHandle(ExeFileName), MinSeg, MaxSeg);
end;
//Mata programa por su nombre...
function KillTask(ExeFileName: string): boolean;
begin
  result:= KillProc(GetProcHandle(ExeFileName));
end;
end.

Nota: La unit "HCBase" no tiene uso, se puede sacar sin problemas. De hecho si no la sacamos no permite la compilación.
Ya me dirá Sergio si estoy en lo cierto.
Gracias.

[santiago14]

Ohh, el código está bastante bueno.
Justo encima del método SaveToPDF dice:

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....c.phtml?t=22344


De igual manera, no deja de estar bueno.
Una vuelta de tuerca mas y podemos tener un exportador PDF que lo haga desde OpenOffice y Office.

Saludos.

[santiago14]

Ohh, el código está bastante bueno.
Justo encima del método SaveToPDF dice:

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....c.phtml?t=22344


De igual manera, no deja de estar bueno.
Una vuelta de tuerca mas y podemos tener un exportador PDF que lo haga desde OpenOffice y Office.

Saludos.

[Sergio]

Olvide el tema del launch.pas y hcbase, bueno, cosas del directo!

El launch.pas que uso es el que has encontrado, solo le añadi en mi caso 3 o 4 funciones extras para "cosas raras" que no se usan en esta unit, así que la que has encontrado es la correcta.

HCBase es una unit que metemos siempre con funciones nuestras se usen o no, por si acaso.

Y lo del mensaje sobre convertir a PDF en MS-Office, bueno, nuestras apps corren en sistemas que escapan de nuestro control, y nunca sabemos si usan Word 97, 2007, OpenOffice, LibreOffice, o lo que sea, ni si tienen o no instalado tal o cual añadido, así que realmente nuestras apps siempre usan una impresora PDF para convertir, sea el tipo de fichero que sea, a PDF (aunque sea con LibreOffice).

Si fuerzas el uso por defecto de una impresora PDF y sobre el fichero haces click derecho, Imprimir, obtienes un PDF, así que si automatizas esto, puedes convertir de autocad a pdf de forma automatica, por eso no nos complicamos la vida.