CreateOleObject

Création d'une instance d'objet OLE

Syntaxe

function CreateOleObject(ClassName: String): ComVariant
ClassName: nom de la classe de l'instance à créer

Remarques

La classe OLE à utiliser doit être enregistrée dans le registre de la machine qui exécute le script.
Sinon, la fonction génère une exception.

Exemples

 
uses COM;

// Impression PDF d'un document Excel (Office >2007)
procedure ExcelFileToPDF(xlsxFilePathName, pdfFilePathName : String);
var
   excel : ComVariant;
   newSession : Boolean;
begin
   const XL_TYPE_PDF = 0;

   // Test si Excel est déjà ouvert
   try
      excel := GetActiveOleObject("Excel.Application");
   except
      excel := CreateOleObject("Excel.Application");
      newSession := True;
   end;

   try
      excel.UserControl := False; // objet utilisé par programmation
      excel.Interactive := False;
      excel.DisplayAlerts := False;

      var wkBook := excel.Workbooks.Open(xlsxFilePathName); // Ouverture du fichier
      wkBook.ExportAsFixedFormat(XL_TYPE_PDF, pdfFilePathName); // Appel de la publication PDF Excel
      wkBook.Close(False); // Fermeture du fichier sans enregistrer
   finally
      // On quitte Excel uniquement si on avait ouvert une nouvelle session
      if newSession then excel.Quit;
      excel := Unassigned; // Important pour bien libérer la liaison OLE
   end;
end;
uses COM;

// Réutilisation de Word ou démarrage d'une nouvelle instance
var word : COMVariant;
try
   word := GetActiveOleObject("Word.Application");
except
   word := CreateOleObject("Word.Application");
end;
word.Visible := True;

// On crée un nouveau document
var doc := word.Documents.Add;

// Insère un paragraphe au début du document
var para := doc.Content.Paragraphs.Add;
para.Range.Text := "1er paragraphe";
para.Range.Font.Bold := True;
para.Format.SpaceAfter := 32;

// Définition d'une constante correspondant au saut de page (doit être passé en Int16)
const cWdBreakType_wdPageBreak = OleInt16(7);

// Insertion d'un saut de page
var range := doc.Bookmarks["\endofdoc"].Range;
range.InsertBreak(cWdBreakType_wdPageBreak);

// Nouveau paragraphe
para := doc.Content.Paragraphs.Add(doc.Bookmarks["\endofdoc"].Range);
para.Range.Text := "suite...";
para.Range.InsertParagraphAfter;
uses SysUtils, COM, System.Info;

function RunCmd(const cmd : String ; const timeOutMs : Integer ; exceptOnTimeout : Boolean = False) : String;
require
   timeOutMs > 0 : 'Invalid timeout';
begin
   var shell := CreateOleObject('WScript.Shell');
   var timeOut := SystemMilliseconds + timeOutMs;
   var app := shell.Exec(cmd);
   try
      // wait loop, with timeout
      while app.Status = 0 do begin
         // I/O buffer has to be emptied regularly, or it could freeze the command
         Result += VarToStr(app.StdOut.ReadAll) + VarToStr(app.StdErr.ReadAll);
         if SystemMilliseconds >= timeOut then begin
            app.Terminate;
            timeOut := 0;
         end else Sleep(50);
      end;
   except
      if app.Status = 0 then
         app.Terminate;
      raise;
   end;
   Result += VarToStr(app.StdOut.ReadAll) + VarToStr(app.StdErr.ReadAll);
   if (timeOut = 0) and exceptOnTimeout then
      raise Exception.Create('Command timed out' + #13#10 + Result);
end;

// ex : OEM char 'é' is returned by WScript.Shell as '‚' (Single Low-9 Quotation Mark)
// Indeed, legacy MS-DOS apps use OEM charset, i.e. code page 850 (Latin-1) on a french setup.
// In code page 850, 'é' is character 130. But as WScript.Shell use ANSI (code page 1252 on a french setup),
// it returns '‚' (i.e. ANSI character 130), that is then converted in unicode ('‚' is unicode char 8218).
//
// So to convert it back, we have to convert unicode char '‚' (code=8218) into ANSI char (code=130).
// Then we have to convert this char (code=130), viewed as an OEM char, into unicode 'é' (code=233)
//
function ANSItoOEM(const s : String) : String;
begin
   var shell := CreateOleObject('WScript.Shell');
   var OEM_CP : Integer = shell.RegRead('HKLM\SYSTEM\CurrentControlSet\Control\Nls\CodePage\OEMCP');
   var ANSI_CP : Integer = shell.RegRead('HKLM\SYSTEM\CurrentControlSet\Control\Nls\CodePage\ACP');
   if (OEM_CP <> ANSI_CP) and (OEM_CP > 0) and (ANSI_CP > 0) then
      Result := CodePageToString(StringToCodePage(s, ANSI_CP), OEM_CP)
   else Result := s;
end;

// launch legacy console apps
// NB : legacy apps outputs use OEM codepage... but Microsoft's WScript.Shell thinks it's ANSI
// so we have to convert back and forth, in order to have correct accented characters
// Another solution could be to use a batch file to launch the legacy app,
// after having called "chcp 1252" to force legacy apps to use ANSI code page.
PrintLn(ANSItoOEM(RunCmd('cmd /c "echo é"', 1000)));
PrintLn(ANSItoOEM(RunCmd('cmd /c "dir C:\"', 1000)));
PrintLn(ANSItoOEM(RunCmd('whoami /priv', 1000)));
PrintLn(ANSItoOEM(RunCmd('getmac', 1000)));
PrintLn(ANSItoOEM(RunCmd('ping -t www.google.fr', 5000))); // infinite ping but 5 seconds timeout
PrintLn(ANSItoOEM(RunCmd('net stop RetailDemo', 5000))); // stop demo service


// Launch app then close it after 5 seconds if it's not done before
PrintLn(RunCmd('mspaint.exe', 5000));
PrintLn(RunCmd('nslookup', 5000));

Classification

COM