没见过这么垃圾的代码吧？骂得起来劲的有分！！

Question

//有网友问起怎么解决的，这是我后来改的整个function，现在看看垃圾得很。仅供参考。//因为要指定虚拟打印机打印，打印成文件到某个地方，所以，看代码的请注意。看不懂别骂娘。
function tForm1.convertToTiffOle(const fname, VPrinter, VPrintPath: string): string;
var
    tname: string;        //临时文件名
    //fsTemp:SHFILEOPSTRUCT;
    xName: string;       // 扩展名
    //OLE 变量
    ConfirmConversions, ReadOnly, AddToRecentFiles,
    PasswordDocument, PasswordTemplate, Revert,
    WritePasswordDocument, WritePasswordTemplate, Format, Encoding,Visible: OleVariant;    MsWord{, MsDoc} : Variant;  //应用程序对象
    filename: OleVariant;
    ItemIndex :OleVariant;    tpath: string;                //临时路径
    eii, ejj, jll, ill, iji: integer;
    ej : boolean;
    OLEInt: OleVariant;    Device: array[0..255] of Char;        //打印机设备
    Driver: array[0..255] of char;
    Port: array[0..255] of char;
    s : array[0..255] of Char;
    s1: array[0..255] of Char;
    PrChanged: boolean;                    //更改默认打印机标识
    PrIndex: integer;
    hDeviceMode: THandle;    jjjj: integer;
    {tempName,} ttttt, sstate: string;
    //tempfile: file;begin
    begin        sstate:='';
        xName:=ExtractFileExt(fname);           //取扩展名
        if  sametext(XName,'.htm') or sametext(xname, '.html') or sametext(XName,'.dot') or sametext(xname, '.rtf') or sametext(XName,'.doc') or sametext(xname, '.txt')  or sametext(XName,'.wri')  or  (sametext(xName,'.xls')) or (sametext(xName,'.xlt')) or  SameText(xName, '.ppt') or SameTExt(xName, '.pps')  or SameTExt(xName, '.pot')  or SameTExt(xName, '.pre')  then
        begin   // 是支持的文件格式
            try
              PrChanged:= false;
              fileName:= fname;
              PrIndex:= 0;
              //result:='';
              while fileInUse(fname) do
              begin
                    if MessageBox(handle, '该文件已被打开，请先关闭。','无法打开',MB_ReTRYCancel) = IDCancel then
                    begin
                        result:='NoWord';
                        exit;
                        break;
                    end
                    else
                        result:='';
              end;
              {for i := 0 to pred(Printer.Printers.Count) do
              begin
                showmessage(Printer.Printers.Strings[i]);
              end;}
              if Printer.Printers.IndexOf(VPrinter) < 0   //找不到参数指定的虚拟打印机。
              then
              begin
                  MessageBox(0, '请安装虚拟打印机。', pchar(Vprinter), MB_IconWarning);
                  result:= '';
                  exit;
              end;
              if Printer.PrinterIndex < 0      //当前系统没有指定默认打印机
              then  Printer.PrinterIndex := Printer.Printers.IndexOf(VPrinter)   //直接指定虚拟打印机为系统默认打印机，不做标记
              else    //系统指定了默认打印机
              if Printer.PrinterIndex <> Printer.Printers.IndexOf(VPrinter)    //默认打印机不是参数指定的虚拟打印机
              then
              begin
                  Printer.GetPrinter (Device, Driver, Port, hDeviceMode);      //取当前默认打印机信息，用于打印完毕后恢复此值。
                  StrCopy (s1, Device);
                  StrCat (s1, ',');
                  StrCat (s1, Driver);
                  StrCat (s1, ',');
                  StrCat (s1, Port);
                  PrIndex:= Printer.PrinterIndex;
                  Printer.PrinterIndex := Printer.Printers.IndexOf(VPrinter);    //更改默认打印机为参数指定的虚拟打印机                  Printer.GetPrinter (Device, Driver, Port, hDeviceMode);    //取新的默认打印机信息用于发消息通知系统。
                  StrCopy (s, Device);
                  StrCat (s, ',');
                  StrCat (s, Driver);
                  StrCat (s, ',');
                  StrCat (s, Port);
                  WriteProfileString ('windows', 'device', s);
                  StrCopy (s, 'windows');
                  SendMessage (HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@s));    //发消息通知系统，“默认打印机”已更改。
                  PrChanged:=true;                 //设标记为真。
              end;
              Xname:=ExtractFileExt(fname);        //求取改扩展为.tif后的文件名。循环以避免原文件中带有'.'号的情况。
        tName := Extractfilename(fName);
        ttttt := 'jimttttt';
        while tName <> ttttt do
        begin
          if ttttt<> 'jimttttt' then tName := ttttt ;
          ttttt := changeFileExt(tname, '');
        end;        tName:=tname + '.tif';        if  sametext(XName,'.htm') or sametext(xname, '.html') or sametext(XName,'.dot') or sametext(xname, '.rtf') or sametext(XName,'.doc') or sametext(xname, '.txt')  or sametext(XName,'.wri') then
            tPath:='Microsoft Word - '+tName
        else
        if SameText(Xname, '.ppt') or SameTExt(Xname, '.pps')  or SameTExt(Xname, '.pot')  or SameTExt(Xname, '.pre') then
            tPath:='Microsoft Word - '+tName
        else
            tpath:=tName;        PrintFileName := tPath;        tPath:=VPrintPath+tPath;     //打印输出的目标文件名。        if FileExists(tPath) then DeleteFile(tPath);              //调用word打印。
              if sametext(XName,'.htm') or sametext(xname, '.html') or sametext(XName,'.dot') or sametext(xname, '.rtf') or sametext(XName,'.doc') or sametext(xname, '.txt')  or sametext(XName,'.wri')  then
              begin
                    try
                    try
                      if not VarIsEmpty(MSword) then  //如果对象已存在。
                      begin
                        MSword.DisplayAlerts := False;
                        MSword.Quit;
                        VarClear(MSword);
                      end;                        MSword := CreateOleObject('Word.Application');  //创建OLE应用程序实例。
                    except
                    raise EMathError.Create('您的系统上可能没有安装MS Word，文件无法转换。');
                    end;
                    try
                    //打开文档的参数设置
                    ConfirmConversions := False;
                    ReadOnly := false;
                    AddToRecentFiles := False;
                    PasswordDocument := '';
                    PasswordTemplate := '';
                    Revert := false;
                    WritePasswordDocument := '';
                    WritePasswordTemplate := '';
                    format := 0;
                    Encoding := 1;
                    Visible := True;
                    //打开文档。
                    MsWord.Documents.Open
                    ( FileName, ConfirmConversions,
                    ReadOnly, AddToRecentFiles, PasswordDocument, PasswordTemplate,
                    Revert, WritePasswordDocument, WritePasswordTemplate, Format, Encoding,Visible );
                    ItemIndex := 1;  //指定文档索引
                    MsWord.Options.CheckSpellingAsYouType := False;
                    MsWord.Options.CheckGrammarAsYouType := False;
                    MsWord.PrintOut;       //打印输出。
        for jjjj:= 0 to 1800 do           //定时循环
        begin
        if fileExists(tpath) then
          break;                       //文件打印完毕则退出循环
        sleep(50);
        end;
                    finally
                    MsWord.ActiveDocument.close;   //关闭文档
                    MsWord.Quit();                 //退出应用
                    end;
                    except
                    on E: Exception do
                    begin
                    WriteLog(4, E.Message);
                    sstate:='NoWord';
                    end;                    end;              end
///////////////to be continued.....

Answer 1

else if SameText(Xname, '.xls') or SameTExt(Xname, '.xlt') then
              begin
                    try
                    try
                      if not VarIsEmpty(MSword) then      //如果对象已存在。
                      begin
                        MSword.DisplayAlerts := False;
                        MSword.Quit;
                        VarClear(MSword);
                      end;                        MSword := CreateOleObject('Excel.Application');                    except
                    raise EMathError.Create('您的系统上可能没有安装MS Excel，文件无法转换。');   //创建OLE应用程序实例。
                    end;
                    try
                    ReadOnly := false;
                    OleInt:= 1;
                    MSword.Workbooks.Open       //打开文档。
                    (FileName);
                    ill:=1;
                    jll:=1;
                    while ill <= MSword.WorkSheets.count do     //循环打印所有的工作表。
                    begin
                        ej:= false;
                        MSword.WorkSheets[ill].Activate;       //激活当前工作表
                        for eii:= 1 to 15 do             //15列，50行内取不到数据则判断此工作表为空表，不打印。
                          begin
                            if ej then break;
                            for ejj:= 1 to 50 do
                            begin
                              if MSWord.WorkSheets[ill].cells[ejj, eii].value <> '' then begin ej:=true;  break; end;
                            end;
                          end;
                        if not ej then         //工作表为空。
                        begin
                          //ShowMessage(intToStr(ill));
                          inc(ill);
                          continue;
                        end;
                        if jll=1 then         //当前是第一张工作表则直接打印。
                          begin
                            MSword.ActiveSheet.PrintOut;
                          end
                        else
                        begin                  //当前不是第一张工作表
                            try
                              for jjjj:= 0 to 200 do    //循环等待，以确保打印已完毕，文件可重命名。
                                begin   //重命名打印后文件，成功则跳出循环。
                                  if renamefile(vprintpath+ stringReplace(extractfilename(fname),extractFileext(fname), '.tif',[]),vprintpath+ 'jimtempsji.tif') then break;
                                  sleep(100);     //等待
                                end;
                              MSword.ActiveSheet.PrintOut;       //打印当前工作表。
                              for jjjj:= 0 to 200 do   //循环等待，以确保打印已完毕，文件可重命名。
                                begin
                                  if renamefile(vprintpath + changefileext(extractfilename(fname),'.tif'),vprintpath+ 'jimteseewwmpsji.tif') then
                                    begin  //重命名打印后文件，成功则跳出循环。
                                      renamefile(vprintpath+ 'jimteseewwmpsji.tif',vprintpath + changefileext(extractfilename(fname),'.tif'));
                                      break;
                                    end;
                                  sleep(100);    //等待
                                end;
                              InsertTIFFImageFile(vprintpath+ changefileext(extractfilename(fname),'.tif'),vprintpath+ 'jimtempsji.tif',vprintpath+ 'jimtempsjiss.tif',0);      //合并tiff文件。
                              deletefile(pchar( vprintpath+ changefileext(extractfilename(fname),'.tif') ));    //删除tiff文件
                              deletefile(pchar( vprintpath+ 'jimtempsji.tif'));
                              renamefile(vprintpath+ 'jimtempsjiss.tif', vprintpath+ changefileext(extractfilename(fname),'.tif'));    //重命名文件
                            except
                              On E: exception do
                              begin
                                writeLog(1, e.Message +vprintpath+ changefileext(extractfilename(fname),'.tif')+' :  '+vprintpath+ 'jimtempsji.tif'+' :  '+vprintpath+ 'jimtempsjiss.tif');
                                MSword.Quit;
                                raise;
                              end;
                            end;
                        end;
                        inc(ill);
                        inc(jll);
                    end;             //循环
                    MSword.Workbooks.Close;   //关闭工作簿
                    finally
                    MSword.Quit;              //退出应用
                    end;
                    except
                    On  E: exception do
                    begin
                    sstate:='NoWord';
                    WriteLog(4, E.Message);
                    end;
                    end;
              end
              else if SameText(Xname, '.ppt') or SameTExt(Xname, '.pps')  or SameTExt(Xname, '.pot')  or SameTExt(Xname, '.pre')  then
              begin
                    exit;    ///此功能已取消。
                    try
                    try
                      if not VarIsEmpty(MSWord) then
                      begin
                        MSWord.DisplayAlerts := False;
                        MSWord.Quit;
                        VarClear(MSWord);
                      end;

Answer 2

MSWord:= CreateOleObject('PowerPoint.Application');                    except
                    raise EMathError.Create('您的系统上可能没有安装MS PowerPoint，文件无法转换。');
                    end;
                    try
                    ReadOnly := false;
                    MSWord.Presentations.Open
                    (fName,ReadOnly,ReadOnly,ReadOnly);
                    //ItemIndex := 1;
                    //readOnly:=true;
                    //MyApp.presentations.PrintOptions.FitToPage:=readOnly;
                    //readOnly:=false;
                    //MyApp.presentations('faff').windows(1).activate;
                    //MyApp.activepresentation.PrintOut;
                    //MSWord.ConnectTo(MSWord.Presentations.Item (ItemIndex));
                    //ppp.
                    //MsWord.presentations.saveas('temp');
                    //MSWord.presentations(0).windows(1).activate;                    //MsWord.presentations.activate;
                    MSWord.ActivePresentation.PrintOut;  ///  (1, MSWord.Slides.Count ,'',1,ReadOnly);                    finally
                    //MsWord.ActivePresentation.close;
                    {MyApp.Quit;
                    MyApp.Disconnect; }
                    //MSWord.Disconnect;
                    MSWord.quit;
                    end;
                    except
                    On  E: exception do
                    begin
                    sstate:='NoWord';
                    writeLog(4, E.Message);
                    end;
                    end;
              end
              else
              begin
                    sstate:='NoWord';
              end;              if PrChanged then
              begin
                //ShowMessage('');
                  Printer.PrinterIndex:=prIndex;
                  WriteProfileString ('windows', 'device', s1);
                  StrCopy (s1, 'windows');
                  SendMessage (HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@s1));
              end;
              if sametext(sstate,'NoWord') then exit;   //出错则退出。            tName:=GetCurrentDirEx + 'temp\'+tname;
            if Fileexists(tName) then
            begin
                iji:= 1;
                tName:=Stringreplace(tName,'.tif','1.tif',[rfReplaceAll,rfIgnorecase]);
                while fileExists(tName) do   //循环，当目标文件已存在，则自动更改文件名。
                    begin
                      tName:=Stringreplace(tName,intToStr(iji)+'.tif',intToStr(iji+ 1)+'.tif',[rfReplaceAll,rfIgnorecase]);   //文件名后加数字。
                      inc(iji);
                    end;
            end;
             for jjjj:= 0 to 100 do    //循环等待，超时则失败。
                begin
                  if  MoveFile(pchar(tPath),Pchar( tName))  then    //移动文件。
                    begin
                      break;       //成功移动文件，退出循环。
                    end;
                  if jjjj=100 then  //超时。
                        begin
                             writeLog(3, '无法转换文件，请重试。');
                            sstate:='err';
                            exit;
                        end;
                  sleep(100);
                   // end;
                end;
            finally
            end;
          //  已经转换为图片了。
        end
        else
        if (sametext(xName,'.bmp')) or (sametext(xName,'.gif')) or  (sametext(xName,'.png')) or (sametext(xName,'.wmf')) or (sametext(xName,'.emf')) or (sametext(xName,'.jpg')) or (sametext(xName,'.jpeg')) or (sametext(xName,'.ico'))  then
        begin     //原文件为图片格式。
            ImageEnIO1.LoadFromFile(fname);    //加载图片到ImageEn.
            if not DirectoryExists(GetCurrentDirEx+'temp') then    //临时目录不存在，则创建。
                mkdir(pchar(GetCurrentDirEx+'temp'));
            tName:= ChangeFileExt(extractfilename(fname),'.tif');
            tName:= GetCurrentDirEx+'temp\'+ tname;  //'f:\abc\tim.tif';
            if Fileexists(tName) then
            begin    //目标文件存在则生成新的文件名
                iji:= 1;
                tName:=Stringreplace(tName,'.tif','1.tif',[rfReplaceAll,rfIgnorecase]);
                while fileExists(tName) do
                    begin
                      tName:=Stringreplace(tName,intToStr(iji)+'.tif',intToStr(iji+ 1)+'.tif',[rfReplaceAll,rfIgnorecase]);
                      inc(iji);
                    end;
            end;
            ImageEnIO1.SaveToFileTIFF(tName);  //保存成tiff格式.
        end
        else
        if sametext(xName,'.tif') or sameText(xname,'.tiff') then
        begin
            if fileexists(fname) then
            begin
               sstate:=fname;            //返回文件名。
            end
            else
            begin
                sstate:='err';
                exit;
            end;
        end;
     end;
  if sstate= '' then
    result:=tName
  else if sstate='err' then
    result:=''
  else
    result:=fName;
end;

Answer 3

谢谢楼主，我的问题基本解决，但是总是觉得调用word打印效率比较底下，！