* ---------------------------------------------------------------------------- 
 *   Вывод на принтер/файл/монитор содержимого файла переданного как параметр. 
 *   02.2004 Добавил паралельный вывод отчетов отправляемых в файл. 
 *   12.2004 Преобразование в MsExcel через систему печати ХБК 
 *   09.2006 Конвертация в Ms Word формат. 
 *   06.2007 При выводе в файл разрешено отражать имя с основанием из-за OpenOff 
 *   03.2008 Удалил вывод отчетов в дублированный каталог -- никто не использует 
 *   06.2010 xHarbour русские буквы переводит в странной кодировке. Делаю преобразование. 
 PROC pFileOutDevice( cFile, nLen, nW, cdbfm ) 
     FIEL compr, filen, begStr, endStr, qtyCopy 
     LOCA nDev   := 1    // Устройство вывода 1-принтер,2-файл,3-экран,4-ХБК,5-Excel через ХБК,6-Принтер через редактор 
     LOCA nBeg   := 1    // Начальная страница 
     LOCA nEnd   := 9999 // Конечная страница. 
     LOCA nQty   := 1    // Количество экземпляров. 
     LOCA cOldCol:=SetColor(), nSel:=Select(), cStr:="", aDbf:={}, cF:="" 
     LOCA nSize:=FileSize(cFile), cString:="", GetList:={} 
     LOCA nI:=0, cSt:="" 
     LOCA axbk:={{"compr",   "L",    1,  0},;    //  Посылка в программу ХБК 
                 {"filen",   "C",    70, 0},; 
                 {"begStr",  "N",    10, 0},; 
                 {"endStr",  "N",    10, 0},; 
                 {"qtyCopy", "N",    10, 0}} 
     PRIV cNameFile:="", cOutFile:="" 
  
     DEFAULT nLen    TO 80 
     DEFAULT nW      TO 6 
     DEFAULT cdbfm   TO "" 
     MEMV->cNameFile   := AllTrim(cFile) 
  
     fSwopen(16,17,7,60,cOther,4) 
     DO WHIL TRUE 
  
         // Из ЭФ читаем параметры печати. 
         @ 5,0 SAY Chr(199)+Repl("─",59)+Chr(182) COLO PosRepl(cOther,Repl(" ",AT("/",cOther)-2)+"N",1) 
         @ 1,2 SAY "Для печати отчета/документа пожалуйста укажите устройство" 
         @ 2,2 SAY "1-Принтер,2-Файл,3-Экр,4-ХБК,5-ExcХБК,6-Редактор,7-Word ." 
         @ 3,2 SAY "начальную        и конечную         страницы из документа" 
         @ 4,2 SAY "а также количество экземпляров печати документа          " 
  
         @2,58 GET nDev                              PICT "9"    VALI nDev>=1 .AND. nDev<=7 
         @3,12 GET nBeg  WHEN nDev==1.OR.nDev==4     PICT "9999" VALI nBeg>=1 
         @3,30 GET nEnd  WHEN nDev==1.OR.nDev==4     PICT "9999" VALI nBeg<=nEnd 
         @4,56 GET nQty  WHEN nDev==1.OR.nDev==4     PICT "999"  VALI nQty>=1 
         READ 
  
 *************   Смотреть как  Lack будет реагировать на данный обработчик глюка. 
         //***   Обработка глюка xHarb когда посылает код 15, если .,- в формате экспорта в офис 
         IF ReadKey() == K_CTRL_O 
             KEYB Chr(K_ENTER) 
             WAIT "" 
             LOOP 
         ENDI 
  
         //  Если отказ, то выход из режима печати. 
         IF LastKey() == K_ESC THEN EXIT 
  
         DO CASE 
         CASE nDev == 1      // Принтер. Печатаем по одной строке с проверкой статуса принтера. 
             @ 6,1 SAY Padc("Выводим документ/отчет/справку..",58) 
             pPrFile( cFile, nBeg, nEnd, nQty, nLen, nW ) 
             @ 6,1 CLEA TO 6,59 
         CASE nDev == 2  // Файл. 
             cOutFile    := Spac(12) 
             @ 6,2 SAY "Введите имя файла (можно с расширением)     " GET cOutFile VALI lOutFile(zConv(cOutFile)) 
             READ 
  
             //  Преобразование имени файла для минимизации ошибок 
             cF      := AllTrim(cOutFile) 
             IF At(".",cF) > 0   //  Файл с расширением 
                 cF  := Left(Alltrim(Token(cF,".",1)),8)+"."+Right(Alltrim(Token(cF,".",2)),3) 
             ELSE                //  Расширение REP по умолчанию 
                 cF  := AllTrim(Left(cF,8))+".REP" 
             ENDI 
  
             IF LastKey() <> K_ESC 
                 COPY FILE (MEMV->cNameFile) TO (cDreport+AllTrim(zConv(cF))) 
             ENDI 
             @ 6,1 CLEA TO 6,58 
         CASE nDev == 3  // Экран. Используем программу просмотра файлов неогр.длины 
             IF !lLookFile( cFile, 0, 0, 24, 79, cColor ) 
                 ErrMess("Системная ошибка... Попробуйте еще раз..",cError) 
             ENDI 
         CASE nDev == 4  //  Система "хочу быть крутым!" 
  
             //  Анализ на наличие системы на компьютере. 
             IF cPathXBK <> NIL                          //  Имеется настройка ХБК 
                 IF !Empty(cPathXBK)                     //  Имеется настройка ХБК 
                     IF File(cPathXBK+"LS_WORKS.DBF")    //  Сист. ХБК запущена 
  
                         //  Ожидание, пока ХБК не удалит предыдущую посылку - не напечатает документ. 
                         IF lFileXbm(cPathXBK+"XBM.DBF") //  Можно печатать документ. 
                             DbCreate(cPathXBK+"XBM.DBF",axbk) 
                             LanUse(cPathXBK,"XBM",NO_INDEX,"TXBM",SHAR_MODE,-1,NEW_SEL) 
                             FilLock(-1) 
                             DbAppend() 
                             compr       := (nLen == 132) 
                             filen       := IF(At(":",cFile)>=1,Alltrim(cFile),DiskName()+":\"+CurDir(DiskName())+"\"+AllTrim(cFile)) 
                             begStr      := nBeg 
                             endStr      := nEnd 
                             qtyCopy     := nQty 
                             DbCloseArea() 
                             DbSelectArea(nSel) 
  
                             //  Ручное управления для блокирования коллизий 
                             @ 6,1 SAY Padc("После ПОЛНОГО окончания печати нажмите Esc",58) 
                             Inkey(0) 
  
                             /****   Делаю для торопыг дополнительную паузу. Если нажать Esc, 
                                     то файл печати сотрется и ХБК выдаст диагностическую ошибку */ 
                             WHIL TRUE 
                                 Inkey(0.3) 
                                 IF File(cPathXBK+"XBM.DBF") 
                                     IF Fyn("Предыдущая печать не окончена! Прервать ее?",cError) THEN EXIT 
                                 ELSE 
                                     EXIT 
                                 ENDI 
                             END 
                             @ 6,1 CLEA TO 6,58 
                         ELSE 
                             ErrMess("Не получилось. Попробуйте еще раз!",cError) 
                         ENDI 
                     ELSE 
                         ErrMess("Система ХБК не запущена на компьютере или не верен маршрут к ней!",cError) 
                     ENDI 
                 ELSE 
                     ErrMess("Каталог системы ХБК не определен!",cError) 
                 ENDI 
             ELSE 
                 ErrMess("Каталог системы ХБК не определен!",cError) 
             ENDI 
         CASE nDev == 5  //  Система "хочу быть крутым!" преобразует БД в таблицу Excel 
             cOutFile    := Spac(8) 
             @ 6,2 SAY "Введите имя файла латинскими буквами            " GET cOutFile VALI !Empty(cOutFile) 
             READ 
  
             IF LastKey() <> K_ESC 
                 IF !Empty(cdbfm) 
                     cOutFile    := Upper(AllTrim(zConv(cOutFile)))+".mse" 
  
                     //  Анализ на наличие системы ХБК на компьютере. 
                     IF cPathXBK <> NIL                          //  Имеется настройка ХБК 
                         IF !Empty(cPathXBK)                     //  Имеется настройка ХБК 
                             IF File(cPathXBK+"LS_WORKS.DBF")    //  Сист. ХБК запущена 
  
                                 //  Пауза. Пока ХБК не обработает предыдущий одноименный файл. 
                                 WHIL File(cPathXBK+cOutFile) 
                                     Inkey(0.1) 
                                     @ 6,1 SAY Padc("Для убыстрения на Windows 9x переключитесь на ХБК.",45) 
                                 END 
  
                                 SELE (cdbfm) 
                                 COPY TO (cPathXBK+cOutFile) 
                                 @ 6,1 SAY Padc("Файл "+AllTrim(cOutFile)+" записан..",58) 
                             ELSE 
                                 ErrMess("Система ХБК не запущена на компьютере!",cError) 
                             ENDI 
                         ELSE 
                             ErrMess("Каталог системы ХБК не определен!",cError) 
                         ENDI 
                     ELSE 
                         ErrMess("Каталог системы ХБК не определен!",cError) 
                     ENDI 
                 ELSE 
                     ErrMess("Отчет пока не преобразуется в таблицу Excel!",cError) 
                 ENDI 
             ENDI 
             @ 6,1 CLEA TO 6,58 
         CASE nDev == 6      // Редактор. 
             IF nSize <= 64000 
                 cString     := MemoRead(cFile)      //  Читаю файл в строку 
                 fswOpen(0,0,24,79,cMainc,13) 
                 @ 0,0 SAY REPL("─",9)+REPL("┼─────────",7) 
                 @24,0 SAY "При желании можно отредактировать документ, запрос на печать появится после  Esc" 
                 @ 1,0 CLEA TO 22,79 
                 DispBox( 23, 0, 23, 79, 2 ) 
                 cString     := MemoEdit(cString,1,0,22,79,TRUE,"FMEdit",232) 
                 MemoWrit( cFile, cString ) 
                 fDeact(cOther) 
 /*  Старый блок работы с редактором 
                 cString := MemoRead(cFile) 
                 fswOpen(0,0,24,79,cMainc,13) 
                 @ 0,0 SAY REPL("─",9)+REPL("┼─────────",7) 
                 @24,0 SAY "При желании можно отредактировать документ, запрос на печать появится после  Esc" 
                 @ 1,0 CLEA TO 22,79 
                 DispBox( 23, 0, 23, 79, 2 ) 
                 MemoWrit( cFile, MemoEdit(cString,1,0,22,79,TRUE,"FMEdit",232) ) 
                 fDeact(cOther) 
 */ 
             ELSE 
                 ErrMess("Отчет слишком большой для редактирования!",cError) 
             ENDI 
         CASE nDev == 7  //  Формат Ms Word посредством системы ХБК. 
             cOutFile    := Spac(8) 
             @ 6,2 SAY "Введите имя файла латинскими буквами без точек  " GET cOutFile VALI !Empty(cOutFile) 
             READ 
  
             IF LastKey() <> K_ESC 
  
                 //  Блокирую ситуацию указать расширение в имени файла 
                 cOutFile    := Upper(AllTrim(Left(AllTrim( cNoSpecSimb(cOutFile) ),8)))+".wrd" 
                 cOutFile    := zConv(cOutFile) 
  
                 //  Анализ на наличие системы ХБК на компьютере. 
                 IF cPathXBK <> NIL                          //  Имеется настройка ХБК 
                     IF !Empty(cPathXBK)                     //  Имеется настройка ХБК 
                         IF File(cPathXBK+"LS_WORKS.DBF")    //  Сист. ХБК запущена 
  
                             //  Пауза. Пока ХБК не обработает предыдущий одноименный файл. 
                             WHIL File(cPathXBK+cOutFile) 
                                 Inkey(0.1) 
                                 @ 6,1 SAY Padc("Для убыстрения вывода переключитесь на ХБК.",58) 
                             END 
  
                             COPY FILE (MEMV->cNameFile) TO (cPathXBK+cOutFile) 
                             @ 6,1 SAY Padc("Файл "+AllTrim(cOutFile)+" записан..",58) 
                         ELSE 
                             ErrMess("Система ХБК не запущена на компьютере!",cError) 
                         ENDI 
                     ELSE 
                         ErrMess("Каталог системы ХБК не определен!",cError) 
                     ENDI 
                 ELSE 
                     ErrMess("Каталог системы ХБК не определен!",cError) 
                 ENDI 
             ENDI 
             @ 6,1 CLEA TO 6,58 
         ENDC 
     ENDD 
     fDeact(cOldCol) 
 *    fErase(cNameFile) 
     RETU 
  
 * --------------------------------------------------------------------------- 
 *   Вывод текстового файла на принтер в соответствии с параметрами и при 
 *   этом проверяется статус принтера при отражении каждой строки и в начале 
 STAT PROC pPrFile( cFile, nBeg, nEnd, nQty, nLen, nW ) 
     LOCA nPage:=0 /*Текущая страница*/, nH:=0 /*handle*/, nQ:=0/*копии*/ 
     LOCA cBuff:="" /*буфер чтения*/, cStr:="" /*буфер печати*/ 
     LOCA nSize:=2048 /*размер буфера чтения*/, cCur:="" /*текущая строка*/ 
     LOCA nI:=0, lStat:=TRUE, nJ:=0, lStr:=TRUE 
  
     IF !File( AllTrim(cFile) ) THEN RETU 
  
     // Проверяем статус принтера перед выводом файла. 
     IF !PrintReady() 
         ErrMess("Принтер не готов... Включите его и попробуйте еще раз.",cError) 
         RETU 
     ENDI 
  
     // Устанавливаем принтер используя стандартную команду операц.системы 
     SET CONS OFF 
     SET PRINTER ON 
  
     DO CASE 
     CASE nLen==80 .AND. nW==6 
         RUN MODE LPT1:80,6  >NUL 
     CASE nLen==80 .AND. nW==8 
         RUN MODE LPT1:80,8  >NUL 
     CASE nLen==132 .AND. nW==8 
         RUN MODE LPT1:132,8 >NUL 
     CASE nLen==132 .AND. nW==6 
         RUN MODE LPT1:132,6 >NUL 
     ENDC 
  
     nH  := Fopen( cFile, 0 )    // Открываем файл для чтения 
  
     BEGIN SEQU 
  
         // Выводим текст из файла на принтер по одной копии 
         FOR nQ := 1 TO nQty 
             Fseek( nH, 0/*смещение*/, 0/*начало*/ ) 
             nPage   := 1            // Начальная страница. 
  
             // Выводим на принтер текущую копию, анализируя необходимость вывода 
             WHIL Len( cBuff:=FreadStr(nH,nSize) ) <> 0 
                 cStr    += cBuff 
                 lStat   := TRUE 
  
                 WHIL TRUE 
                     // Не можем выделить подстроку из накапливаемой строки. 
                     IF ( nI:=At(CRLF,cStr) ) == 0 THEN EXIT 
  
                     cCur    := Subs( Token(" "+cStr,CRLF,1), 2 ) 
                     nJ      := At( Chr(12), cCur ) 
  
                     // Признак окончания страницы, переводим текущий счетчик 
                     IF nJ <> 0 THEN lStr := FALSE 
                     cStr    := Subs( cStr, nI+2 ) 
  
                     IF nPage >= nBeg .AND. nPage <= nEnd 
  
                         // Сбой на принтере. Отказ пользователя от дальнейшей печати. 
                         IF !lPrStr( cCur ) THEN BREAK 
  
                     ENDI 
                     nPage   += IF( lStr, 0, 1 ) 
                     lStr    := TRUE 
                 END 
             END 
         NEXT nQ 
     END 
  
     Fclose( nH ) 
     RUN MODE LPT1:80,6  >NUL 
  
     SET PRINTER OFF 
     SET CONS ON 
     RETU 
  
 * --------------------------------------------------------------------------- 
 *           Функция распечатки строки с проверкой статуса принтера. 
 STAT FUNC lPrStr( cStr ) 
  
     cStr    := cStr+CRLF 
     IF Inkey() == K_ESC THEN RETU FALSE 
     ?? cStr 
     RETU TRUE 
  
 * --------------------------------------------------------------------------- 
 *   Функция проверки правильности имени введенного файла *.rep 
 *   06.2007 Разрешено расширение. Возвращаю преобразованное имя файла. 
 STAT FUNC lOutFile(cFile) 
     cFile   := AllTrim(cFile) 
  
     //  Запрет пустого имени 
     IF Empty(cFile) THEN RETU FALSE 
  
     IF At(".",cFile) > 0    //  Файл с расширением 
         cFile   := Left(Alltrim(Token(cFile,".",1)),8)+"."+Right(Alltrim(Token(cFile,".",2)),3) 
     ELSE                    //  Расширение REP по умолчанию 
         cFile   := AllTrim(Left(cFile,8))+".REP" 
     ENDI 
  
     //  Проверка на существование 
     IF File(cDreport+AllTrim(cFile)) 
         IF !Fyn("Файл с введенным именем существует... Переписать?",cError) THEN RETU FALSE 
     ENDI 
     RETU TRUE