// Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.

#include "s_public.ch"
#include "s_refer.ch"
#include "my.ch"
#include "inkey.ch"

STATIC aData:= {{},{},{}}  // Стеки

/**********
*  PutNetRepl()
*  Запись массива в БД в сетевом режиме
***/
FUNCTION PutNetRepl(aArray,lYesLock)
   LOCAL lRez := .F.
   IF RecLock(,lYesLock)
      AEVAL(aArray, {|x,i|IF(x==NIL,,FIELDPUT(i,x))})
      UNLOCK
      COMMIT
      lRez := .T.
   ENDIF
RETURN( lRez )


/**********
*  PutNetAdd()
*  Запись массива в БД в сетевом режиме
*  с образованием новой записи
***/
FUNCTION PutNetAdd(aArray, lNoCommit,lYesLock)
   LOCAL lRez:= .F.
   IF AddRec(lYesLock)
      AEVAL(aArray, {|x,i|IF(x==NIL,,FIELDPUT(i,x))})
      UNLOCK
      IF lNoCommit == NIL
        COMMIT
      ENDIF
      lRez := .T.
   ENDIF
RETURN (lRez)

*
/**********
*  StepChar()
*  Определить следующий порядковый номер
*  Параметр типа С
***/
FUNCTION StepChar(cCode)
   IF LASTREC() = 0
      cCode := STRZERO(1,LEN(&cCode))
   ELSE
      DBGOBOTTOM()
      cCode := STRZERO(VAL(&cCode)+1,LEN(&cCode))
   ENDIF
RETURN cCode
**********

FUNCTION GatherS(aBuf)
  // записывает из 2-мерного массива {<имя поля>,<значение>} если существует такое поле victor
LOCAL lRecLock, j
  IF (lRecLock := (ASCAN(dbRLockList(),{|nRec| nRec = RECNO() }) != 0)) .OR. RecLock()
    AEVAL(aBuf, {|x,i|    IF(VALTYPE(x)='A' .AND. VALTYPE(x[1])='C' .AND.(j:= FIELDPOS(x[1]))>0,;
                             FIELDPUT(j,x[2]),;
                             NIL)  })
    IF !lRecLock
      dbUnlock()
    ENDIF
  ENDIF


RETURN (FCOUNT())

*
/**********
*  Function: ScatterS()
*  *  C Level _hrdd.prg
***/
FUNCTION ScatterS(buf)
  // запоминает в 2-мерный массив {<имя поля>,<значение>}  victor
   IF buf == NIL
      buf := ARRAY(FCOUNT())
   ENDIF

  If LEN(buf)>0
     AEVAL(buf,{|x,i| buf[i] := {FIELDNAME(i),FIELDGET(i)} })
  EndIF
RETURN (buf)

/**********
*  Function: Gather()
*  Notes: write to database from array to current record
***/
FUNCTION Gather(aBuf,aLogic)
//[aLogic]-массив длиною как aBuf - значащее поле (.T.) или нет (.F.), в этом случае пмшутся только значащие
LOCAL lRecLock
  IF (lRecLock := (ASCAN(dbRLockList(),{|nRec| nRec = RECNO() }) != 0)) .OR. RecLock()
    AEVAL(aBuf, {|x,i|IF(EMPTY(aLogic).OR.aLogic[i],FIELDPUT(i,x),NIL)},1,FCOUNT())
    IF !lRecLock
      dbUnlock()
    ENDIF
  ENDIF
RETURN (FCOUNT())


/**********
*  C Level _hrdd.prg
***/
FUNCTION Scatter(buf)
   IF buf == NIL
      buf := ARRAY(FCOUNT())
   ENDIF

  If LEN(buf)>0
     AEVAL(buf,{|x,i| buf[i] := FIELDGET(i) })
  EndIF
RETURN (buf)


/**********
*  aFieldIni()
*  Инициализация массива
***/
FUNCTION aFieldIni(buf)
  LOCAL l := FCOUNT(), i
  LOCAL fin[l], fit[l], fil[l], fid[l]

  l = MIN( AFIELDS(fin, fit, fil, fid), LEN(buf) )

  For i = 1 To l
    DO Case
      CASE fit[i]="N"
        buf[i] = 0
      CASE fit[i]="C"
        buf[i] = REPLICATE( " ", fil[i] )
      CASE fit[i]="D"
        buf[i] = CTOD(SPACE(8))
      CASE fit[i]="L"
        buf[i] = .F.
    EndCASE
  Next
RETURN l
/**********
*  GetAnyThing(nRow,nCol,Param,cColor) -> lRet
*  Ввод некоторой переменной
***/
FUNCTION GetAnyThing(Param,cPict,cMess,nRow,nCol,cColor,lInput,bValid,cRefer)
   LOCAL aSet := SaveSet(), lRet := .T., nRight, GetList := {}
   LOCAL bakParam := Param
   cColor := IF(cColor==NIL,SetColor(),cColor)
   lInput := IF(lInput==NIL,.F.,lInput)
	 IF(VALTYPE(bValid)=="B",,bValid:={|| .T. })
   nRight := nCol+LEN(cMess)+LEN(TRANSFORM(SPACE(200),cPict))+6
   ShadowBox('',nRow,nCol,nRow+2,nRight,cColor)
   SetColor(cColor)
   @ nRow+1,nCol+3 SAY cMess
   Set cursor on
   IF EMPTY(cRefer)
   	 @ nRow+1,nCol+4+LEN(cMess) GET Param PICTURE cPict VALID EVAL(bValid)
   ELSE
   	 @ nRow+1,nCol+4+LEN(cMess) REFER cRefer GET Param PICTURE cPict VALID EVAL(bValid)
   ENDIF
   READ
   Set Cursor Off
   lRet := IF(LASTKEY()=27,.F.,lRet)
   RestSet(aSet)
RETURN IF(lInput,IF(lRet,Param,bakParam),lRet)

/**********
*  GetPeriod() -> lRet
*  Ввод периода отчета
***/
FUNCTION GetPeriod(nRow,nCol,nPeriod,nQM,dDateBeg,dDateEnd)
   LOCAL aSet := SaveSet(), nChoice := 1, lRet := .T.,;
         cColor1 := 'w+/w', cColor2 := 'n/w,w+/n,,,n/w',;
         aMess := { ' 1. За число   ',;
                    ' 2. За месяц   ',;
                    ' 3. За квартал ',;
                    ' 4. За период  ' }

   nChoice := BoxMenu(' Период ',nRow,nCol,aMess,'',nChoice,;
                        '',cColor2,cColor1)
   DO CASE
      CASE nChoice = 0
         lRet := .F.
      CASE nChoice = 1
         * отчет за дату
         dDateBeg := CURR_DATA
         lRet := DayReport(nRow+2,nCol+5,@dDateBeg)
      CASE nChoice = 2
         * отчет за месяц
         lRet := MonthReport(nRow+3,nCol+5,@nQM,@dDateBeg,@dDateEnd)
      CASE nChoice = 3
         * отчет за квартал
         lRet := QuartReport(@nQM,@dDateBeg,@dDateEnd)
      CASE nChoice = 4
         * отчет за период
         lRet := PeriodReport(nRow+5,nCol+5,@dDateBeg,@dDateEnd)
   ENDCASE
   nPeriod := nChoice
   RestSet(aSet)
RETURN lRet


/**********
*  PeriodReport() -> lRet
*  За какой период отчет?
***/
STATIC FUNCTION PeriodReport(nRow,nCol,dDayBeg,dDayEnd)
   LOCAL cClrOld := SetColor(),;
         cColor  := 'n/bg,gr+/n,,,n/bg'

   dDayBeg := CURR_BEG
   dDayEnd := CURR_END
   ShadowBox('',nRow,nCol,nRow+3,nCol+26,cColor)
   SetColor(cColor)
   Set Cursor on
   @ nRow+1,nCol+4 SAY 'Период с..:' GET dDayBeg VALID;
                       ValidDate(dDayBeg) PICTURE "@D"
   @ nRow+2,nCol+4 SAY '       по.:' GET dDayEnd VALID;
                       ValidDate(dDayEnd) PICTURE "@D"
   READ
   SetColor(cClrOld)
   Set Cursor Off

RETURN IF(LASTKEY()=27,.F.,.T.)


/**********
*  QuartReport() -> lRet
*  За какой квартал отчет?
***/
STATIC FUNCTION QuartReport(nQuart,dDayBeg,dDayEnd)
   dDayBeg := CURR_BEG
   dDayEnd := CURR_END
   nQuart  := QUARTER(CURR_DATA)
RETURN .T.


/**********
*  MonthReport() -> lRet
*  За какой месяц отчет?
***/
STATIC FUNCTION MonthReport(nRow,nCol,nMonth,dDayBeg,dDayEnd)
   LOCAL cClrOld := SetColor(), nNum := 1, i, lRet := .T.,;
         cColor  := 'n/bg,gr+/n,,,n/bg',;
         nBeg := MONTH(CURR_BEG), aNames := { SPACE(10),SPACE(10),SPACE(10) }

   FOR i = nBeg TO nBeg + 2
      dDayBeg := ADDMONTH(CURR_BEG,nNum-1)
      aNames[nNum] := ' '+PADRIGHT(CMONTH(dDayBeg),9)
      nNum++
   NEXT
   SetColor(cColor)
   nNum := BoxMenu(' Месяц ',nRow,nCol,aNames,'',1,'',cColor)
   IF nNum > 0
      nMonth := nNum + nBeg - 1
      dDayBeg := ADDMONTH(CURR_BEG,nNum-1)
      dDayEnd := EOM(dDayBeg)
   ELSE
      lRet := .F.
   ENDIF
   SetColor(cClrOld)
RETURN lRet


/**********
*  DayReport(nRow,nCol,dDay) -> lRet
*  Дата получения отчета?
***/
STATIC FUNCTION DayReport(nRow,nCol,dDay)
   LOCAL cClrOld := SetColor(),;
         cColor  := 'n/bg,gr+/n,,,n/bg'

   ShadowBox('',nRow,nCol,nRow+2,nCol+29,cColor)
   SetColor(cColor)
   Set Cursor On
   @ nRow+1,nCol+4 SAY 'Введите дату :' GET dDay VALID ValidDate(dDay);
                                        PICTURE "@D"
   READ
   Set Cursor Off
   SetColor(cClrOld)
RETURN IF(LASTKEY()=27,.F.,.T.)


/**********
*  LongFio()
*  Вывод полного ФИО в одну стpоку
***/
FUNCTION LongFio(f,n1,n2)
RETURN ALLTRIM(f) + " " + ALLTRIM(n1) + " " + LTRIM(n2)

/**********
*  ShortFio()
*  Фоpмиpует из полной стpоки ФИО стpоку с Фамилией И.О.
***/
FUNCTION ShortFio(f,n1,n2)
RETURN PADRIGHT(ALLTRIM(f)+" "+SUBSTR(ALLTRIM(n1),1,1)+;
                  "."+SUBSTR(ALLTRIM(n2),1,1)+".",25)


/**********
*  All_Index()
*  Переиндексация всех баз данных
***/
FUNCTION All_Index(cTask, lOnly, nArxiv, cBase, lNoBreake, lFox, lUpdateCrc, lNoTest)
//lOnly:Только сTask
LOCAL aSet := SaveSet(),cColor := "W/B"
LOCAL bFor := {||(.T.)}, nVProces, cOldScreen
LOCAL cScr, cPath, cFile, cArm
LOCAL cTmpDbf   := TEMPFILE( GlobalTmpPath )
LOCAL cTmpOld   := TEMPFILE( GlobalTmpPath )
LOCAL aArm:= {}, nSek := 0
FIELD ARM, PATH, FILE, NAME IN MAIN
FIELD FILE_PATH, FILE_NAME, VID_NNOPER

PRIVATE nMaxNnoper := 0


IF EMPTY(lNoTest).AND.EMPTY(cBase) .AND. ;
  BestActive( '2', LoadPath()+IF(EMPTY(cTask),'',GetAllArm(cTask)[6]) ) == '1'
  SayError( {'Необходимо всем пользователям БЭСТ выйти из программ в главное меню'} )
  RETURN(NIL)
ENDIF
dbCLOSEALL()

lOnly:=IF(lOnly==NIL,.F.,lOnly)
IF( nArxiv == NIL, nArxiv := 1, )

IF (lOnly==NIL.AND.TYPE('ST_FILE')=='C').AND.;
  !YesOrNo(;
  "Рекомендуется всем пользователям БЭСТ выйти из программ в главное меню",,;
  " Запускать? ","   Отмена  ")
  RETURN (.F.)
ENDIF

IF(!EMPTY(lFox).AND.!EMPTY(FILESEEK(LoadPath()+"axs.axs")), lFox:= NIL, )
IF EMPTY(lFox)
  ScrMain()
  ScrTitul(00,"СЕРВИСНЫЕ ФУНКЦИИ: ВОССТАНОВЛЕНИЕ ИНДЕКСНЫХ ФАЙЛОВ")
  IF EMPTY(lNoBreake)
    ScrTitul(24,"Esc: Прервать индексацию")
  ENDIF
  SetColor(cColor)
  ShadowBox("",06,09,14,68,cColor)
  @ 08,13 SAY "База данных....:"
  @ 10,13 SAY "Имя индекса....:"
  @ 12,13 SAY "Комментаpий....:"
ENDIF

cOldScreen := SCREENSTR( 6, 13, 34 )
   BEGIN SEQUENCE

    //Lexx
    PlategPack()
    if GLOBALTASK<>"01" //sos
      WinTmpZap()
    endif

    IF !( NetUse("MAIN",LoadPath()+"Base_All") )
      BREAK
    ENDIF


    // Коректировка номера проводки
    IF GlobalTask == '10' .AND. EMPTY(cTask) .AND. FILE( _PRO_PATH+'OP.DBF' )

      IF !( NetUse( "TMP_OP", _PRO_PATH+'OP.DBF',,.T. ) )
        BREAK
      ENDIF

      FERASE(_PRO_PATH+'OP.IDX')
      INDEX ON PADR(UPPER( ALLTRIM(TMP_OP->FILE_PATH)+ALLTRIM(TMP_OP->FILE_NAME)),100)+' ' ;
            TO (_PRO_PATH+'op.idx') FOR VID_NNOPER== 1  .AND. !DELETED()
      TMP_OP->( dbCloseArea() )
      IF !( NetUse( "TMP_OP", _PRO_PATH+'OP.DBF', _PRO_PATH+'OP.IDX',.T. ) )
        BREAK
      ENDIF
      SELECT MAIN
    ENDIF


    nVProces := Proces_Ini(,17,,"")
    IF !EMPTY(cTask)
      cTask := UPPER(cTask)
      IF lOnly
         bFor := {||Proces_Update(nVProces,RecNo()/LastRec()),UPPER(ARM)==cTask.AND.BestActive( '2', LoadPath()+GetAllArm(UPPER(ARM))[6] ) == '0' }
      ELSE
         bFor := {||Proces_Update(nVProces,RecNo()/LastRec()),(UPPER(ARM)==cTask .OR. UPPER(ARM)=="00").AND.BestActive( '2', LoadPath()+GetAllArm(UPPER(ARM))[6] ) == '0' }
      ENDIF
    ELSE
      bFor := {|| Proces_Update(nVProces,RecNo()/LastRec()) }
    ENDIF



    SETCOLOR(COL_BROWSE)
  IF EMPTY(lFox)
    nSek := SECONDS()
    dbEval({|| SAYSCREEN( PADR("[ "+ALLTRIM(NAME)+" ]",40,'═') ,6,13 ),   ;
                 IF( PackIndex( ARM, ALLTRIM(LoadPath()+PATH), ALLTRIM(FILE),;
                            cTmpDbf,cTmpOld,nArxiv, cBase, @lNoBreake, @lUpdateCrc )==2,BREAK(1),);
           }, bFor)
    nSek := SECONDS() - nSek
    ELSE
      dbEval({|| AADD(aArm, {PATH, FILE, ARM})}, bFor)
      dbCLOSEALL()
      AEVAL(aArm,{|x|;
                 cScr:= SAVESCREEN(),;
                 BS_RUN(cPROPATH+"FOX\"+"indexarm.exe -t "+LoadPath()+" "+;
                       ALLTRIM(x[1])+ALLTRIM(x[2])+" "+ALLTRIM(x[1])+;
                       "Bases_Er "+;
                       IF(M->GlobalTask=="10","INDEX&PACK ","INDEX ")+;
                       IF(nArxiv==1, "MAIN",IF(nArxiv==2, "ARC", "ALL"))+;
                       " DBF "+UPPER(x[3])),;
                  DispBegin(),;
                  RESTSCREEN(,,,,cScr),;
                  DispEnd();
                 })
    ENDIF
    IF EMPTY(cTask)
      // Чистим базу запросов, если получится
      IF FILE("SEMAFOR.DBF").AND.NetUseExc( "Semafor0", "SEMAFOR", "SEMAFOR" )
         ZAP
         SEMAFOR0->( dbCloseArea() )
      ENDIF

      // Упакуем список предприятий
      IF FILE('LABEL.PRO')

        USE (cProPath+'LABEL.PRO') NEW EXCLUSIVE ALIAS LABEL VIA 'DBFCDX'
        IF USED()
          PACK
          dbCloseArea()
        ENDIF
      ENDIF
      // упакуем список станций
      IF FILE('STATION.PRO')
        USE (cProPath+'STATION.PRO') NEW EXCLUSIVE ALIAS STATION VIA 'DBFCDX'
        IF USED()
          PACK
          dbCloseArea()
        ENDIF
      ENDIF

      IF FILE(cProPath+"dic\b4tables.dbf") //индексация словаря
         Busy(.T.,"Индексация словаря")
         DicIndexCreate(cProPath+"dic\b4tables",cProPath+"dic\b4fields",.T.)
         Busy(.F.)
      ENDIF

      Proces_End(nVProces)
    ENDIF

   RECOVER

   END SEQUENCE

   dbCloseAll()

   FERASE( cTmpDbf )
   FERASE( cTmpOld )
   FERASE( _PRO_PATH+'OP.IDX' )

   altd()

   IF nMaxNNOper > VAL(RIGHT(STR(StepPlus(),17,0),10)) //Запись нужного
     StepPlus( _NNOPER_INI, nMaxNnoper+2 )
   ENDIF

   cColor  := LoadPath()+'TMP\'
   bFor := DIRECTORY( cColor + "*.*" )  // Проверяем на временные файлы
   IF LEN( bFor ) > 1
     FOR lOnly := 1 TO LEN( bFor )
       IF (cTmpOld := FOPEN( cColor+bFor[lOnly][1], 1 )) <> -1  // ТОЛЬКО ДЛЯ ЗАПИСИ
         FCLOSE( cTmpOld )
         FERASE( cColor+bFor[lOnly][1])
       ENDIF
     NEXT
   ENDIF

   If EMPTY(cTask) .OR. cTask=="01"
     Clear_Bank()
   EndIf


   SetCPXXOne(cProPath+'LABEL.PRO')
   SetCPXXOne(cProPath+'LOGIN.PRO')
   SetCPXXOne(cProPath+'STATION.PRO')
   SetCPXXOne(cProPath+'USER.PRO')



   RestSet(aSet)
   IF EMPTY(cBase)
     BestActive( '4', LoadPath() )  // Завершение индексации
   ENDIF
   //SayAndWait({'Индексация завершена!',;
   //            'Время индексации: '+STR(nSek,6,0)+' сек.'})


  if GlobalTask == '10' .and. File(LoadPath()+'BASES_FP.DBF') .and. NetUseEXC( 'BASES_FP', LoadPath()+'BASES_FP.DBF' )
   ZAP
   dbCloseArea()
  endif



RETURN (.T.)

STATIC FUNCTION PackIndex(cArm, cPath, cFile,cTmpDbf,cTmpOld, nArxivIndex, cBase, lNoBreake , lUpdateCrc)
// В случае присутствия в базе  BASES_??.DBF
// следущих полей существенно меняется обработка
// DELETE - .T. - в ключевое выражение по FOR добавляется !DELETE(),
//                а если в переиндексируемой базе присутствует
//                еще и поле DELETED, то в FOR условие добавляется !DELETE
//                только в случае если поле PACK отсутствует или PACK - .F.
//          .F. или поля нет - то ключевое выражение остается прежним
// PACK   - .T. - все записи входящие в teg будут удалены
//          .F. или поля нет - обработка стандартная
// YES_INDEX  - .T. или поля нет то tag включается в bag иначе нет
// RELATION   - переиндексация с RELATION
// lUpdateCrc - .T., то обновление CRC без контроля предыдущего значения

  LOCAL  cNameNtx, cNtxKey, cForKey,;
         lUnigue  := SET(_SET_UNIQUE), nRecNo := 0
  LOCAL nProces, nI, nJ, nKey := 0, aStruct, cFor,bNNoper
  LOCAL cPathDbf := "", cTagName := '',aField:={}
  LOCAL cNameDbf := "", aRelation := {}, aTRel
  LOCAL cIndexTmp := LOWER(TEMPFILE( GlobalTmpPath, "IDX" ))
  LOCAL aHead := {;
                   "   Упаковка базы данных    ",;
                   "Построение индексного файла" ;
                  }
  Local IsUnique := NIL // Уникальный индекс
  Local IsPackIt := NIL // Уникальный индекс

  FIELD NAME_DBF, TAG_NOMER, TAG_NAME, PATH_DBF, ;
        MESSAGE, INDEX, FOR_KEY                   IN INDEX
  FIELD ARM, PATH, FILE, NAME IN MAIN
  FIELD OPIS_FIELD, VID_NNOPER
  MEMVAR NMAXNNOPER

  cFile := TOKEN(cFile,".",1)
  lUpdateCrc := !EMPTY(lUpdateCrc)

  IF EMPTY(cIndexTmp) .OR. !FILE(cIndexTmp)  // А вдруг пригодится
    cIndexTmp := 'tmp_tmp_.tmp'
  ENDIF

  IF FILE(cPath+cFile+".cdx")
    FERASE(Path+cFile+".cdx")
  ENDIF

  IF !(FILE(cPath+cFile+".dbf") .AND. NetUse("Index", cPath+cFile) )
    RETURN NIL
  ENDIF
  IF nArxivIndex == 3
    cFor := IF(FieldPos("STATUS") = 0,".T.","!INDEX->STATUS")
  ELSEIF nArxivIndex == 2
    cFor := IF(FieldPos("STATUS") = 0,"'ARC\' $ UPPER(INDEX->PATH_DBF)","'ARC\' $ UPPER(INDEX->PATH_DBF).AND.!INDEX->STATUS")
  ELSE
    cFor := IF(FieldPos("STATUS") = 0,"!('ARC\' $ UPPER(INDEX->PATH_DBF))","!('ARC\' $ UPPER(INDEX->PATH_DBF)).AND.!INDEX->STATUS")
  ENDIF

  IF FIELDPOS( "YES_INDEX" ) <> 0
    cFor := "("+cFor+")" + ".AND.YES_INDEX"
  ENDIF

  IF ValType( cBase ) == 'C'
    cFor := "("+cFor+")" + ".AND.  UPPER(ALLTRIM(NAME_DBF))=='"+cBase+"'"
  ENDIF

  FERASE(cIndexTmp)

  ordCondSet( cFor,&("{||"+cFor+"}"),,,,,RECNO(),,,,)
  ordCreate(cIndexTmp,;
            "TAG_PATH",;
            "UPPER(INDEX->PATH_DBF+INDEX->NAME_DBF+INDEX->TAG_NOMER)",;
            {|| UPPER(INDEX->PATH_DBF+INDEX->NAME_DBF+INDEX->TAG_NOMER) },;
            )

  dbCloseArea()

  // Сбросим ссылку
  GetSetIndex(cArm,1)

  IF !NetUse("Index", cPath+cFile, cIndexTmp  )
    FERASE(cIndexTmp)
    RETURN(0)
  ENDIF
  GO TOP

  DO WHILE !EOF()
    bNNoper := {||.T.}
    aField  := {}

    cPathDbf := LoadPath()+  IF(LEN(ALLTRIM(INDEX->PATH_DBF))==0, "", UPPER(ALLTRIM(INDEX->PATH_DBF)))
    cNameDbf := UPPER( cPathDbf + ALLTRIM( NAME_DBF ) )

//    if !IsAds()
       SetCPXXOne(cNameDbf+".DBF") // выставим дос страницу
//      else
       // уберем CP866 для ADS
       // ADS падал в прошлом ... на этом
//       SetCPXXOne(cNameDbf+".DBF",Chr(0))
//    endif
    IF SELECT( 'TMP_OP' ) > 0 .AND. ; // Нужна корекция номеров проводок
            TMP_OP->( dbSEEK( PADR(UPPER( ALLTRIM(INDEX->PATH_DBF)+ALLTRIM( NAME_DBF ) ),100)) )
       TMP_OP->( dbEVAL({|| AADD( aField, { ALLTRIM(OPIS_FIELD), VID_NNOPER } ) },,;
                        {||PADR(UPPER( ALLTRIM(TMP_OP->FILE_PATH)+ALLTRIM(TMP_OP->FILE_NAME)),100) == ;
                           PADR(UPPER( ALLTRIM(INDEX->PATH_DBF)  +ALLTRIM( NAME_DBF )       ),100);
                        };
                       );
               )
        bNNoper := {||AEVAL( aField, {|x|nMaxNnoper := MAX( VAL(RIGHT(STR(FIELDGET(x[1]),17,0),10)),nMaxNnoper) })}


    ENDIF



    nI := 0
    @ 08,30 CLEAR TO 12,65
    @ 08, 30 SAY RIGHT( cNameDbf, 30 )
    @ 10, 30 SAY SPACE(30)
    @ 12, 30 SAY SUBSTR(MESSAGE,1,35)

    nKey := INKEY()                     // Для Выхода
    CLEAR TYPEAHEAD
    IF nKey == K_ESC .AND. EMPTY( lNoBreake )
       nKey :=NoOrYes( {'Прервать индексацию задачи "'+ALLTRIM(NAME)+'"?'}, 1,;
                       {'Перейти к следующей','Прервать совсем','Не прерывать'} )
      IF nKey == 1 .OR.nKey == 2
        RETURN(nKey)
      ENDIF
    ENDIF

    // Удалим индекс, чтобы не росли и чтобы немешали перезаписи
    FERASE( cNameDbf+".cdx" )

    IF FILE(cNameDbf+'.dbf') .AND. NetUseExc("NEW", cNameDbf)

      aTRel := {cNameDbf,{}}

      // Меняем имена на позиции для NNOPER
      AEVAL( aField, {|x,i| aField[i,1]:=FIELDPOS(x[1])})

      //  Пакуем только из настройки и если нет индекса удаленных записей
      IF GlobalTask == '10'
        #ifdef NO_ERROR
          nRecNo := 0
          IF (!EMPTY(RECNO_CRC) .OR. lUpdateCrc).AND.INDEX->(FieldPos("PACK")) != 0 .AND. FieldPos("DELETE") != 0 .AND. FieldPos("CRC") != 0
            DBEVAL({|| IF(NEW->DELETE,dbDelete(),NIL),IF(!DELETE().AND.(lUpdateCrc .OR. FIELD->CRC = GetInfoCRC()),FIELD->CRC := GetInfoCRC(++nRecNo),NIL) })
          ELSEIF INDEX->(FieldPos("PACK")) != 0 .AND. FieldPos("DELETE") != 0
            DBEVAL({|| dbDelete() },{|| NEW->DELETE })
          ELSEIF (!EMPTY(RECNO_CRC) .OR. lUpdateCrc).AND.FieldPos("CRC") != 0
            DBEVAL({|| FIELD->CRC := GetInfoCRC(++nRecNo) },{|| !DELETE().AND.(lUpdateCrc .OR. FIELD->CRC = GetInfoCRC()) })
          ENDIF
        #else
          IF INDEX->(FieldPos("PACK")) != 0 .AND. NEW->(FieldPos("DELETE")) != 0
            DBEVAL({|| dbDelete() },{|| NEW->DELETE })
          ENDIF
        #endif
        //altd()
        if Index->(FieldPos ( "PackIt" )) != 0
           IsPackIt := Index->PackIt
          else
           IsPackIt := NIL
        end

        IF IsPackIt == NIL
              PACK
           elseif IsPackIt
              PACK
              IsPackIt := NIL
        END
        COMMIT

      ENDIF

      BEGIN SEQUENCE
      nI := 0

      SELECT INDEX

      DO WHILE !EOF() .AND. UPPER(cPathDbf+ ALLTRIM( NAME_DBF ) ) == cNameDbf
        cNameNtx := LOWER(cPathDbf + ALLTRIM( NAME_DBF )+".CDX")
        cNtxKey  := UPPER(ALLTRIM( INDEX ))
        cTagName := ALLTRIM( TAG_NAME )
        cForKey := ALLTRIM( FOR_KEY )
        // V@
        if FieldPos ( "UNIQUE" ) != 0.and.Field->UNIQUE // Уникальный индекс
           IsUnique := .t.
        end

        IF FieldPos("DELETE") != 0 .AND. FIELD->DELETE
          cForKey := IF(cForKey == "","!DELETE()"+IF(NEW->(FieldPos("DELETE")) != 0,".AND."+IF(FieldPos("PACK") != 0.AND.FIELD->PACK,"","!")+"DELETE",""),"!DELETE().AND."+IF(NEW->(FieldPos("DELETE")) != 0,IF(FieldPos("PACK") != 0.AND.FIELD->PACK,"","!")+"DELETE.AND.","")+"("+cForKey+")")
        ENDIF
        IF FieldPos("LRELATION") = 0 .OR. !INDEX->LRELATION
          // Индексируем по TEG'ам без RELATION
          @ 10, 30 SAY RIGHT( cTagName, 30 )
          @ 12, 30 SAY SUBSTR(MESSAGE,1,35)
          SELECT NEW

          IF !EMPTY(aField)
             GO TOP
             DBEVAL(bNNoper)
             GO TOP
          ENDIF

          IF EMPTY(cForKey)
            ordCondSet(,,,,,,RECNO())
          ELSE
            ordCondSet(cForKey,&("{||"+cForKey+"}"),,,,,RECNO())
          ENDIF

          if IsUnique == NIL
             ordCreate( cNameNtx, cTagName, cNtxKey, &("{||"+cNtxKey+"}"), )
            elseif IsUnique // Явно установлена уникальность
             ordCreate( cNameNtx, cTagName, cNtxKey, &("{||"+cNtxKey+"}"),.t. )
             IsUnique := NIL
          end


          // сбросим пересчет NNOPERа
          aField := {}

          bNNoper := {||.T.}

          SELECT INDEX
        ELSEIF FieldPos("RELATION") != 0
          AADD(aTRel[2],{cTagName,cNtxKey,IF(EMPTY(cForKey),NIL,cForKey),IF(ValType(INDEX->RELATION) = "A",INDEX->RELATION,{}),INDEX->MESSAGE})
        ENDIF
        SKIP
      ENDDO

      NEW->( dbCloseArea() )

      IF !EMPTY(aTRel[2])
        AADD(aRelation,aTRel)
      ENDIF

      END SEQUENCE

   ELSE
    SELECT INDEX
    SKIP
   ENDIF
 ENDDO
 Index->(DBCLOSEAREA())
 FERASE(cIndexTmp)
 IF FILE(cPath+cFile+".cdx")
   FERASE(Path+cFile+".cdx")
 ENDIF

 // Индексируем все базы c RELATION
 IndexRelation(@aRelation,@nProces)

 // Выставим ссылку
 GetSetIndex(cArm,2)
 SELECT Main
RETURN(0)

*******************************
*  Очистка баз данных АРМ "БАНК" от сбойных записей
*
STATIC PROCEDURE Clear_Bank()
LOCAL nProcess:=0
//
// Подсистемы "Банк" может и не быть ...
// в удаленных модулях V@
//
Local pBank := LoadPath()+"BANK\"
if File(pBank+"RS_NEW.DBF")
   If NetUseExc("RS_NEW", pBank+"RS_NEW")
      ZAP
      CLOSE RS_NEW
   EndIf
endif


if File(pBank+"RSDOC.DBF")
   If NetUseExc("RSDOC",pBank+"RSDOC")

      nProcess:=Proces_Ini(LASTREC(), 17,,"Очистка базы RSDOC")
      DBSETORDER(0)
      DBGOTOP()
      DELETE ALL FOR (Proces_Update(nProcess), FIELD->STATUS==0)
      PACK
      DBCOMMIT()
      Proces_End(nProcess)
      CLOSE RSDOC
  EndIf
endif

RETURN

FUNCTION MyHandler
BREAK
RETURN (NIL)
//----------------------------------------------------------------------------//
                 FUNCTION IndexRelation(aRelation,nProces)
//----------------------------------------------------------------------------//
// Индексация с RELATION
// aRelation массив структуры :
// {
//   {
//     имя DBF с путем,
//     {
//       имя тега,
//       ключевое выражение,
//       FOR условие,
//       {
//         {
//           имя базы потомок,
//           нужный тег,
//           ключевое выражение
//          }
//         ..................
//       }
//     }
//    .......................
//   }
//  .........................
// }
LOCAL aRel, aCloseBase
AEVAL(aRelation,{|_aRel|;
              aRel := _aRel,;
              IF(;
                 NetUseExc("NEW",aRel[1]),;
                 (;
                   aCloseBase := {},;
                   AEVAL(aRel[2],{|atRel|;
                                 NEW->(AEVAL(atRel[4],{|attRel| IF(SELECT(attRel[1]) != 0 .OR. (NEW->(NetUse(attRel[1],attRel[1])) .AND. (AADD(aCloseBase,attRel[1]),.T.)),((attRel[1])->(ORDSETFOCUS(attRel[2])),dbSetRelation( attRel[1],&("{||"+attRel[3]+"}"),attRel[3])),NIL) })),;
                                 DispOutAt(10,30,RIGHT( atRel[1], 30 )),;
                                 DispOutAt(12,30,SUBSTR(atRel[5],1,35)),;
                                 NEW->(ordCondSet(IF(!EMPTY(atRel[3]),&("{||"+atRel[3]+"}"),),atRel[3],,,,,1),ordCreate(LOWER(aRel[1]),atRel[1],atRel[2],&("{||"+atRel[2]+"}"),));
                                  }),;
                   NEW->(dbCloseArea()),;
                   AEVAL(aCloseBase,{|cAlias| (cAlias)->(dbCloseArea()) });
                  ),;
                 NIL;
                );
                })

RETURN NIL
//----------------------------------------------------------------------------//
                 FUNCTION GetSetIndex(cArm,nRet)
//----------------------------------------------------------------------------//
// Сохраняет и возвращает информацию о переиндексируемых АРМ'ах
// nRet - 1 - очищает ссылку
//        2 - выставляет ссылку
//        3 - возвращает признак и сбрасывает ссылку
//        4 - возвращает признак
LOCAL nBit, xRet
LOCAL aArm := {"00","01","02","03","04","05","06","07","08","09","KB","TZ","SR","ZR","TV","MG","14","CN","IP"}
PRIVATE cIndexArm := REPLICATE("0",32)

cIndexArm := Glob_Vars({"cIndexArm"},.F.,"INI\global_v")[1]

IF ValType(cArm) != "C" .OR. (nBit := ASCAN(aArm,{|x| x = cArm })) = 0 .OR. nRet = NIL
 RETURN .F.
ELSEIF nRet = 1
 // Очистим ссылку ПО ТЕКУЩЕМУ АРМ'у
 xRet := cIndexArm := NTOC(ClearBit(CTON(cIndexArm,2),nBit,nBit),2,32,"0")
 Glob_Vars({{"cIndexArm",cIndexArm}},.T.,"INI\global_v")
ELSEIF nRet = 2
 // Выставим ссылку ПО ТЕКУЩЕМУ АРМ'у
 xRet := cIndexArm := NTOC(SetBit(CTON(cIndexArm,2),nBit,nBit),2,32,"0")
 Glob_Vars({{"cIndexArm",cIndexArm}},.T.,"INI\global_v")
ELSEIF nRet = 3
 // Вернем и сбросим ссылку ПО ТЕКУЩЕМУ АРМ'у
 xRet := IsBit(CTON(cIndexArm,2),nBit)
 cIndexArm := NTOC(ClearBit(CTON(cIndexArm,2),nBit,nBit),2,32,"0")
 Glob_Vars({{"cIndexArm",cIndexArm}},.T.,"INI\global_v")
ELSEIF nRet = 4
 // Вернем ссылку ПО ТЕКУЩЕМУ АРМ'у
 xRet := IsBit(CTON(cIndexArm,2),nBit)
ENDIF

RETURN xRet

//--------------------------------------------------------------------------
FUNCTION PushData(xData,nStek)
//-Закинуть что-либо в стек-------------------------------------------------
// nStek - необязательный номер стека == 1(2)
IF(nStek==NIL, nStek:= 1, )
AADD(aData[nStek], xData)
RETURN NIL

//--------------------------------------------------------------------------
FUNCTION PopData(lNoDel,nStek)
//--Извлеч из стека---------------------------------------------------------
// lNoDel - Только посмотреть (без извлечения)
LOCAL nLenData, xData
IF(nStek==NIL, nStek:= 1, )
nLenData:= LEN(aData[nStek])
IF nLenData!= 0
   xData:= aData[nStek,nLenData]
   IF( EMPTY(lNoDel), ASIZE(aData[nStek], nLenData-1), )
ENDIF
RETURN xData

//--------------------------------------------------------------------------
FUNCTION MyPosRepl(cInString,cSetString,nStart)
//--------------------------------------------------------------------------
// Замена POSREPL если срока вставляется в сторку - cInString - ссылка
IF(nStart==NIL,nStart:=1,)
IF(cInString==NIL,cInString:="",)
IF(cSetString==NIL,cSetString:="",)
cInString:= STUFF(cInString,nStart,LEN(cSetString),cSetString)
RETURN cInString

//--------------------------------------------------------------------------
FUNCTION PlategPack()
//--------------------------------------------------------------------------
    LOCAL cPath

    DBPUSH()
    IF  TYPE("PRN0_BEST_PRINT")=="C"
        cPath:=PRN0_BEST_PRINT
    ELSE
        cPath:=""
    ENDIF
    IF  FILE(cPath+"Plateg.dbf" ).AND.NetUseExc("Plateg",cPath+"PLATEG")
        DBEVAL({|| RecLock(),DBDELETE(),DBUNLOCK() },{|| FIELD->COPY==0 })
        PACK
        DBCLOSEAREA()
    ENDIF
    DBPOP()

RETURN NIL

//
// Установление кодовой страницы в DBF-файлах
//
FUNCTION SetCP866(cPathToBase,lMess)
    LOCAL i,c,nProces
    LOCAL aArmPath:={},aFiles:={}
    LOCAL nHandl,cCodePage:=" "

BEGIN SEQUENCE
    IF  EMPTY(cPathToBase)
        cPathToBase:=LoadPath()
    ENDIF
    IF  IIF(EMPTY(lMess),.T.,YesOrNo({"Необходимо всем пользователям БЭСТ выйти из программ","в главное меню!"},," Продолжить ","   Отмена   ",,,COL_ERROR))
        IF  !NetUse("__MAIN",cPathToBase+"Base_All")
            BREAK
        ENDIF
        DBEVAL({||AADD(aArmPath,UPPER(cPathToBase+ALLTRIM(FIELD->PATH)+ALLTRIM(FIELD->FILE)))})
        DBCLOSEAREA()

        nProces := Proces_Ini(LEN(aArmPath),17,,"Составление списка файлов")
        FOR i:=1 TO LEN(aArmPath)
            IF  FILE(aArmPath[i]).AND.NetUse("__MAIN",aArmPath[i])
                DO WHILE !EOF()
                    c:=UPPER(cPathToBase+ALLTRIM(__MAIN->PATH_DBF)+ALLTRIM(__MAIN->NAME_DBF)+".DBF")
                    IF  ASCAN(aFiles,{|x|x==c})==0
                        AADD(aFiles,c)
                    ENDIF
                    DBSKIP()
                ENDDO
                DBCLOSEAREA()
            ENDIF
            Proces_Update(nProces,i/LEN(aArmPath))
        NEXT
        Proces_End(nProces)
        nProces := Proces_Ini(LEN(aFiles),17,,"Обработка баз")
        FOR i:=1 TO LEN(aFiles)
            IF  (nHandl:=FOPEN(aFiles[i],2)) <> -1
                FSEEK(nHandl,29,0)
                FREAD(nHandl,@cCodePage,1)
                IF  cCodePage<>CHR(101)
                    FSEEK(nHandl,29,0)
                    FWRITE(nHandl,CHR(101),1)
                ENDIF
                FCLOSE(nHandl)
            ENDIF
            Proces_Update(nProces,i/LEN(aFiles))
        NEXT
        Proces_End(nProces)
    ENDIF
END SEQUENCE

RETURN NIL

//--------------------------------------------------------------------------
FUNCTION WinTmpZap()
//--------------------------------------------------------------------------
    LOCAL aWinTmp:={},cOldAlias:=ALIAS(),i

//    AEVAL(DIRECTORY(LoadPath()+"WINTMP\*.DBF"),{|x| AADD(aWinTmp,LoadPath()+"WINTMP\"+x[1]) })
    if FILE(LoadPath()+"BANK\WINRSDOC.DBF") //sos
      AADD(aWinTmp,LoadPath()+"BANK\WINRSDOC.DBF")
      IF  !EMPTY(aWinTmp)
        FOR i:=1 TO LEN(aWinTmp)
          if NetUseExc("WinTemp",aWinTmp[i])
           ZAP
           DBCLOSEAREA()
          endif
        NEXT
      ENDIF
    ENDIF
    IF  !EMPTY(cOldAlias)
        DBSELECTAREA(cOldAlias)
    ENDIF
RETURN NIL
//
FUNCTION SetCPXX(cPathToBase,nCode)
    LOCAL i,c,cFiles
    LOCAL aArmPath:={},aFiles:={}
    Local aNotDbf := {}

        aFiles := DIRECTORY( cPathToBase + "*.DBF", 'D')

        FOR i:=1 TO LEN(aFiles)
            cFiles := Substr(aFiles[i,1],1,At(".",aFiles[i,1])-1)
            If Select(cFiles) != 0
               DBCloseArea(cFiles)
            EndIf
            SetCPXXOne(cPathToBase+aFiles[i,1],nCode)
        NEXT
RETURN NIL

Procedure SetCPXXOne(cFile,nCode)
  LOCAL nHandl,cCodePage:=" "
  nCode := if(nCode == NIL,Chr(101),Chr(nCode)) // Default CP 866
  IF  (nHandl:=FOPEN(cFile,66)) <> -1
                FSEEK(nHandl,29,0)
                FREAD(nHandl,@cCodePage,1)
                IF  cCodePage<>nCode
                    FSEEK(nHandl,29,0)
                    FWRITE(nHandl,nCode,1)
                ENDIF
                FCLOSE(nHandl)
  ENDIF
Return


FUNCTION _DESCEND(p1,p2)
Return DESCEND(p1,p2)





//--------------------------------------------------------------------------//
FUNCTION All_TEX()
//--------------------------------------------------------------------------//
  LOCAL aSet := SaveSet(), aSetKeys := SaveSetKey()
  LOCAl oGet,nI,lastIn15,i
  LOCAL nRow := 2
  LOCAL aWidth:={;
                  { '1', 'Узкая   (A4)' }, ;
                  { '2', 'Широкая (A3)' }, ;
                  { '3', 'Произвольная' }  ;
                }
  LOCAL aNo:={'Да ','Нет'},sF5
  LOCAL aNo1:={'<Настр.кодов>','<Настр.кодов>'}
  LOCAL aNo2:={'<Настройка шрифта>','<Настройка шрифта>'}
  LOCAL aPHeads:={;
                  { '0', 'Не печатать            ' }, ;
                  { '1', 'По умолчанию           ' }, ;
                  { '2', 'С наименованием колонок' }, ;
                  { '3', 'С нумерацией колонок   ' };
                 }
  LOCAL aYes:={'Да ','Нет'}
  LOCAL aPType:={;
                  { 1, 'Сетевой  ' }, ;
                  { 0, 'Локальный' };
                }
  LOCAL aPaper:={'Лист ','Рулон'},;
        aVPaper :={"Качественная" ,"Быстрая     "},;
        aColor := {{.T.,"Цветной    "},{.F.,"Монохромный"}},;
        aEdit := { "вызывать   ",;
                   "не вызывать"},;
        aDevice := {;
                       { 'LPT1', 'Параллельный порт 1' }, ;
                       { 'LPT2', 'Параллельный порт 2' }, ;
                       { 'LPT3', 'Параллельный порт 3' }, ;
                       { 'LPT4', 'Параллельный порт 4' }, ;
                       { 'LPT5', 'Параллельный порт 5' }, ;
                       { 'COM1', 'Послед-ный порт   1' }, ;
                       { 'COM2', 'Послед-ный порт   2' }  ;
                     },;
        aOrint := {{'0',' Портрет '},;
                   {'1',' Ландшафт'}}
  Local aWinPrn := {;
                    {0,'Нет.                          '},;
                    {1,'Сервер печати ( BestPrn )     '},;
                    {2,'Генератор отчетов для Windows '} ;
                   }
// Временно ...     {3,'Печать готовых отчетов        '} ;

  Local xPos1 := 45
  // Изменение 3.60
  PRIVATE aIn[29],GetList:={}
  help_code  := "2.1"
  altd()
  USE (cProPath+'STATION.PRO') ALIAS STATION NEW SHARED
  nI:=FIELDSIZE(FIELDNUM("DEVICE"))
  FOR i:=1 TO LEN(aDevice)
  aDevice[i,1]:=PADR(aDevice[i,1],nI)
  NEXT
  CLOSE



  aIn[1]  :=  INST_COLOR
  aIn[2]  :=  PADR(PRN0_DEVICE,nI)
  aIn[3]  :=  PRN0_TYPE
  aIn[4]  :=  PRN0_WIDTH
  aIn[5]  :=  PRN0_PAPER
  aIn[6]  :=  PRN0_STR
  aIn[7]  :=  PRN0_PROBROS
  aIn[8]  :=  PRN0_PAUSE
  aIn[9]  :=  PRN0_PSEVDO
  aIn[10] := .F.
  lastIn15 := aIn[11] :=(TYPE('CURR_PROF')=='D'.AND.CURR_PROF != CTOD('01.01.15'))
  aIn[12]  :=  PRN0_E_YES
  aIn[13]  :=  PADR(PRN0_E_PATH,100)
  aIn[14]  :=  PADR(PRN0_E_FILE,12)
  aIn[15]  :=  PRN0_WTYPE
  nI := AT('.',PRN0_FONT)
  aIn[16]  :=  PADL( LEFT(  PRN0_FONT,nI-1 ),8)+;
               PADR( SUBSTR(PRN0_FONT,nI   ),4)
  aIn[17] := PRN0_HEAD
  aIn[18] := PRN0_NUMSTR
  aIn[19] := PRN0_BEGSTR
  aIn[20] := PRN0_LSUM
// Alex2
  aIn[21] := CURR_DTIME
  aIn[22] := IIF(EMPTY(CURR_FTIME),PADR("  Дата : "+CHR(38)+"DATE  Время :  "+CHR(38)+"TIME "+CHR(38)+"CTLF "+CHR(38)+"CTLF",50),PADR(CURR_FTIME,50))
  //aIn[21] := CURR_DTIME
  //aIn[22] := PADR(CURR_FTIME,50)
// Изменение 3.60
  aIn[23]  := PRN0_PTYPE
  aIn[24]  := PRN0_WIN
  aIn[25]  := PRN0_ORINT
  aIn[26]  := PRN0_OTSTUP
  aIn[28]  := PRN0_WIN_PRINT
  if aIn[28] == 1 .or. aIn[28] == 2
     aIn[27]  := PADR(PRN0_BEST_PRINT,50)
     aIn[29]  := if(!Empty(PRN0_WPRINTER),PADR(AllTrim(PRN0_WPRINTER),254),Space(254))
  else
     aIn[27]  := Space(50)
     aIn[29]  := Space(254)
  end
  Load_Help( "Настройка" )      // Раздел Помощи

  ScrMain()
  nI := 6

  SETCOLOR(COL_INPUT)
  @ 01,03,23,77 BOX "╔═╗║╝═╚║ "
  @ 01,23 SAY "[ Техническая настройка ]"

  IF !HB_GT_VERSION()$"GTWVT".OR.!"BIN"$UPPER(exename())
     @ nRow, 07 SAY "Цветовой режим эксплуатации........ :"
  ELSE
     @ nRow, 07 SAY "Экран.............................. :"
  ENDIF
  //           1234567890123456789012345678901234567890123456789012345678901234567890123456789
  //                    1         2         3         4         5         6         7
  @ nRow+ 1, 07 SAY "Параметры DOS печати"
  @ nRow+ 2, 09 SAY   "- Имя устройства................. :"
  @ nRow+ 3, 09 SAY   "- Тип принтера................... :"
  @ nRow+ 3, 48 SAY SPACE(20) COLOR COL_INPUTF
  @ nRow+ 4, 09 SAY   "- Ширина каретки................. :"
  @ nRow+ 5, 09 SAY   "- Вид бумаги..................... :        Строк на страницу :"
  @ nRow+ 6, 09 SAY   "- Проброс страницы............... :     Пауза после страницы :"
  @ nRow+ 7, 09 SAY   "- Вид печати..................... :"
  @ nRow+ 8, 09 SAY   "- Программа загрузки шрифтов..... :"
  @ nRow+ 9, 09 SAY   "- Шапка в начале листа........... :"
  @ nRow+10, 09 SAY   "- Нумерация страниц.............. :        Начальный номер :"
  @ nRow+11, 09 SAY   "- Итоги в конце страницы......... :"
  @ nRow+12, 09 SAY   "- Печать даты и времени.......... :        Формат :"
  @ nRow+13, 09 SAY   "- Вывод в формате WINDOWS........ :"
  @ nRow+14, 09 SAY   "- Ориентация листа при печати.... :"
  @ nRow+15, 09 SAY   "- Отступ сверху.................. :"
  @ nRow+16, 05 SAY "Внешний редактор не вызывать из катал:"
  @ nRow+17, 09 SAY   "- Имя редактора.................  :"
  @ nRow+18, 05 SAY 'Программа печати для Windows....... :'
  @ nRow+19, 09 SAY   '- Путь к файлу обмена............ :'
  @ nRow+20, 09 SAY   '- Имя принтера................... :'

  IF M_Open_Base( {'FCPRINT','PRN_CODE'} )


    SELECT FCPRINT
    MakeRefer('RefP','Принтеры',1,{'Код','Наименование'},;
            {3,28,5},COL_REFER,{'NPRINTER'},{'aIn[3]'},;
            'aIn[3]',{FIELDBLOCK('NPRINTER'),FIELDBLOCK('NAME')},;
            {{'','Код принтера?','NPRINTER','aIn[1]'}},,,,,,;
            {||sF5:=SETKEY(K_F5,{||InputPrinter()})},;
            {||SETKEY(K_F5,sF5)},,,;
            {||SAYSCREEN(' F5:Корректировка ',13,29),1};
            )
    aIn[3] := PADL( aIn[3],LEN(FCPRINT->NPRINTER))
    SELECT Prn_Code


  SETCOLOR(COL_GET)







    IF !HB_GT_VERSION()$"GTWVT".OR.!"BIN"$UPPER(exename())
       oGet := GETNEW(nRow, xPos1,  { |x| RotateBlock(x,aColor,'aIn[1]')} )
       oGet:Reader := { |oGet| RotateAndReader( oGet,aColor, 04, 17 ) }
       AADD( GetList, oGet )
       aIn[1]:=.T.


    ELSE


      oGet := GETNEW(nRow, xPos1,  { |x|IF(x<>NIL,If(Lastkey() != 27,SetFont(),),),;
                                 aNo2[2] } )
      oGet:Reader := { |oGet| CondReader( oGet,,aNo2) }
      AADD( GetList, oGet )
    ENDIF



// имя устройства
   oGet := GETNEW(nRow+2, xPos1,  { |x| RotateBlock(x,aDevice,'aIn[2]')} )
   oGet:Reader := { |oGet| RotateAndReader( oGet,aDevice, 6, 23 ) }
   AADD( GetList, oGet )
// - тип принтера сетевой/локальный
  oGet := GETNEW(nRow+3,32,{|x| RotateBlock(x,aPType,'aIn[23]') } ,"aIn[23]")
  oGet:reader := {|oGet| RotateAndReader( oGet,aPType,,oGet:col,COL_REF1)}
  AADD(GetList,oGet)

// тип принтера
   oGet := GETNEW(nRow+3, xPos1,  { |x| IF(x<>NIL,aIn[3]:=x,),;
                                 FCPRINT->(DBSEEK(UPPER(aIn[3]))),;
                                 SAYSCREEN(FCPRINT->NAME,5,48),aIn[3] } )
   oGet:Reader := { |oGet| ReferGetReader( oGet,'RefP' ) }
   AADD( GetList, oGet )

   // настройка кодов принтера
   oGet := GETNEW(nRow+3, 63,  { |x|IF(x<>NIL,If(Lastkey() != 27,UprSimv(VAL(aIn[3])+2),),),;
                                 aNo1[2] } )
   oGet:Reader := { |oGet| CondReader( oGet,,aNo1) }
   AADD( GetList, oGet )

//  ширина каретки
   oGet := GETNEW(nRow+4, xPos1,  { |x| IF(aIn[15]=='1',aIn[4]:=80,IF(aIn[15]=='2',aIn[4]:=132,)),;
                                 GetList[nI+1]:Display(),;
                                 RotateBlock(x,aWidth,'aIn[15]')} )
   oGet:Reader := { |oGet| RotateAndReader( oGet,aWidth, 10, 30 ) }
   AADD( GetList, oGet )
//
  @ nRow+4, 62 GET aIn[4] PICTURE "999" WHEN {|| aIn[15] =='3' } VALID {||aIn[4]>0}
//5 вид бумаги
  oGet := GETNEW(nRow+5,xPos1,{|x| CondBlock(x,aPaper,'aIn[5]') })
  oGet:reader := {|oGet| CondReader( oGet,,aPaper)}
  AADD(GetList, oGet)

  //6 строк на страницу
  @ nRow+5, 72 GET aIn[6] PICTURE "999" VALID {||aIn[6]>0}

  // Проброс страницы
  oGet := GETNEW(nRow+6,xPos1,{|x| CondBlock(x,aNo,'aIn[7]') })
  oGet:reader := {|oGet| CondReader( oGet,,aNo)}
  AADD(GetList, oGet)

  //8 пауза после страницы
  oGet := GETNEW(nRow+6,72,{|x| CondBlock(x,aNo,'aIn[8]') })
  oGet:reader := {|oGet| CondReader( oGet,,aNo)}
  AADD(GetList, oGet)
  //9 вид печати
  oGet := GETNEW(nRow+7,xPos1,{|x| CondBlock(x,aVPaper,'aIn[9]') })
  oGet:reader := {|oGet| CondReader( oGet,,aVPaper)}
  AADD(GetList, oGet)
  // программа загрузки шрифтов
  @ nRow+8, xPos1 GET aIn[16] PICTURE "@K XXXXXXXX.XXX" ;
           VALID {|| aIn[16]:=PADL(ALLTRIM(LEFT(aIn[16],8)),8)+'.'+;
                              PADR(ALLTRIM(RIGHT(aIn[16],3)),3), .T.}
// печать заголовка
   oGet := GETNEW(nRow+9, xPos1,  {|x| RotateBlock(x,aPHeads,'aIn[17]') } )
   oGet:Reader := { |oGet| RotateAndReader( oGet,aPHeads, 16, 24 ) }
//   oGet:Display()
   AADD( GetList, oGet )
// нумерация страниц
  oGet := GETNEW(nRow+10,xPos1,{|x| IF(x==NIL, aIn[18], aIn[18]:=(x==aYes[1])),;
                            IF(aIn[18],aYes[1],aYes[2])} ,"aIn[18]")
  oGet:reader := {|oGet| CondReader( oGet,,) }
//  oGet:Display()
  AADD(GetList, oGet)

  @ nRow+10, 69 GET aIn[19] PICTURE "999" WHEN {|| aIn[18] } VALID {|| aIn[19] > 0 }

// итоги на странице
  oGet := GETNEW(nRow+11,xPos1,{|x| IF(x==NIL, aIn[20], aIn[20]:=(x==aYes[1])),;
                            IF(aIn[20],aYes[1],aYes[2])} ,"aIn[20]")
  oGet:reader := {|oGet| CondReader( oGet,,) }
//  oGet:Display()
  AADD(GetList, oGet)
// время и дата
  oGet := GETNEW(nRow+12,xPos1,{|x| IF(x==NIL, aIn[21], aIn[21]:=(x==aYes[1])),;
                            IF(aIn[21],aYes[1],aYes[2])} ,"aIn[21]")
  oGet:reader := {|oGet| CondReader( oGet,,) }
//  oGet:Display()
  AADD(GetList, oGet)
  @ nRow+12, 59 GET aIn[22] PICTURE "@S17" WHEN {|| aIn[21] }
  //печать в формате WINDOWS
  oGet := GETNEW(nRow+13,xPos1,{|x| IF(x==NIL, aIn[24], aIn[24]:=(x==aYes[1])),;
                            IF(aIn[24],aYes[1],aYes[2])} ,"aIn[24]")
  oGet:reader := {|oGet| CondReader( oGet,,)}
  AADD(GetList, oGet)
   // ориентация листа при печати
   oGet := GETNEW(nRow+14, xPos1,  {|x| RotateBlock(x,aOrint,'aIn[25]') } )
   oGet:Reader := { |oGet| RotateAndReader( oGet,aOrint, 16, 24 ) }
   oGet:PreBlock := {|| PRN_CODE->(dbSEEK('LS   ')).AND.!EMPTY(FieldGet(VAL(aIn[3])+2)) }
//   oGet:Display()
   AADD( GetList, oGet )
   // отступ сверху
   @ nRow+15, xPos1 GET aIn[26] PICTURE "99"  VALID {|| aIn[26] >= 0 }

  // РЕДАКТОР
  // Внешний редактор не вызывать
  oGet := GETNEW(nRow+16,22,{|x| IF(x==NIL, aIn[12], aIn[12]:=(x==aEdit[1])),;
                            IF(aIn[12],aEdit[1],aEdit[2])} ,"aIn[12]")
  oGet:reader := {|oGet| CondReader( oGet,,aEdit)}
  AADD(GetList, oGet)

  // путь к редактору
  @ nRow+16, 45 GET aIn[13] PICTURE "@S20" VALID {|| ValidPath(aIn[13]) } When aIn[12]
  // имя редактора
  @ nRow+17, xPos1 GET aIn[14] PICTURE "@K"   VALID {|| ValidPath(aIn[13],aIn[14]) } When aIn[12]

   oGet := GETNEW(nRow+18,xPos1,{ |x| RotateBlock(x,aWinPrn,'aIn[28]')} )
   oGet:picture:=REPLICATE("#",LEN(aWinPrn[1,2]))
   oGet:Reader := { |oGet| RotateAndReader( oGet,aWinPrn ) }
   AADD( GetList, oGet )

  //путь к файлу обмена
  @ nRow+19, xPos1 GET aIn[27] PICTURE "@S30" VALID {|| ValidPathWP(aIn[27]) } When {|| if(Empty(aIn[27]).and.aIn[28] == 2,if(ExistPathWP(),aIn[27] := Padr(diskname()+':'+dirname()+'\WinRep'+if(!IsMsNT(),'\',''),50),),),aIn[28] == 1.or.aIn[28] == 2}
  // имя принтера
  @ nRow+20, xPos1 REFER "RefRWP" GET aIn[29]  PICTURE "@S30" When {||if(aIn[28] == 2.and.!Empty(aIn[27]),MakeRWP(aIn[27]),),aIn[28] == 2.and.!Empty(aIn[27])}


   altd()

  AEVAL( GetList, {|x| x:Display() } )

  SET CURSOR ON
  READ
  SET CURSOR OFF
    altd()
  IF LASTKEY() <> K_ESC
     INST_COLOR := PRN0_COLOR        :=  aIn[1]
     PRN0_DEVICE       :=  TRIM(aIn[2])
     PRN0_TYPE         :=  aIn[3]
     PRN0_WIDTH        :=  aIn[4]
     PRN0_PAPER        :=  aIn[5]
     PRN0_STR          :=  aIn[6]
     PRN0_PROBROS      :=  aIn[7]
     PRN0_PAUSE        :=  aIn[8]
     PRN0_PSEVDO       :=  aIn[9]
     PRN0_E_YES        :=  aIn[12]
     PRN0_E_PATH       :=  ALLTRIM(aIn[13])
     PRN0_E_FILE       :=  ALLTRIM(aIn[14])
     PRN0_WTYPE        :=  aIn[15]
     PRN0_FONT         :=  LTRIM(aIn[16])
     PRN0_HEAD         :=  aIn[17]
     PRN0_NUMSTR       :=  aIn[18]
     PRN0_BEGSTR       :=  aIn[19]
     PRN0_LSUM         :=  aIn[20]
     CURR_DTIME        :=  aIn[21]
     CURR_FTIME        :=  aIn[22]
     PRN0_PTYPE        :=  aIn[23]
     PRN0_WIN          :=  aIn[24]
     PRN0_ORINT        :=  aIn[25]
     PRN0_OTSTUP       :=  aIn[26]
     PRN0_BEST_PRINT   :=  if(aIn[28] == 0.or.aIn[28] == 3,Space(50),AllTrim(aIn[27]))
     PRN0_WIN_PRINT    :=  aIn[28]
     PRN0_WPRINTER     :=  if(aIn[28] == 0.or.aIn[28] == 1.or.aIn[28] == 3,Space(254),aIn[29])


     IF !EMPTY(PRN0_BEST_PRINT) .AND. RIGHT(PRN0_BEST_PRINT,1) <> '\'
       PRN0_BEST_PRINT+='\'
     ENDIF

     SaveStation() // Сохраним настройку станции

  ENDIF

   ELSE
    Error_Use()
  ENDIF
 // dbCLOSEALL()
  RestSet(aSet)
  RestSetKey(aSetKeys)
  CLEAR TYPEAHEAD

RETURN NIL

STATIC FUNCTION InputPrinter()
LOCAL cName:=Name,GetList:={}
LOCAL sLeft:=SETKEY(K_LEFT,NIL)
LOCAL sRight:=SETKEY(K_RIGHT,NIL)
LOCAL sRet:=SETKEY(K_RETURN,NIL)
LOCAL sF5:=SETKEY(K_F5,NIL)
@ ROW(),COL()+4 GET cName
SETCURSOR(1)
READ
SETCURSOR(0)
IF LASTKEY()!=K_ESC
   RecLock()
   REPLACE Name WITH cName
   UNLOCK
ENDIF
SETKEY(K_LEFT,sLeft)
SETKEY(K_RIGHT,sRight)
SETKEY(K_RETURN,sRet)
SETKEY(K_F5,sF5)
RETURN(3)

//
Static Function ExistPathWP(xPath) // V@
Local oDisk := DiskName()
Local oDir  := DirName()
Local lOk := .f.
   if xPath == NIL
      xPath := DiskName()+':'+DirName()
   end
      xPath := Upper(AllTrim(xPath))
      xPath += If( Right(xPath,1) == '\','','\' )
      xPath += 'WinRep'+if(!IsMsNT(),'\','')
      lOk     := ( DirChange(xPath) == 0 )
      DiskChange(oDisk)
      DirChange(oDir)
Return lOk

//
Static Function ExistPath(xPath) // V@
Local oDisk := DiskName()
Local oDir  := DirName()
Local lOk := .f.
   if xPath == NIL
      xPath := DiskName()+':'+DirName()
   end
      xPath := Upper(AllTrim(xPath))
      if !IsMsNT()
         xPath += If( Right(xPath,1) == '\','','\' )
      end
      lOk     := ( DirChange(xPath) == 0 )
      DiskChange(oDisk)
      DirChange(oDir)
Return lOk
//
Static Function ValidPathWP(xPath)
Local lRet := .f.
//altd()
xPath := AllTrim(xPath)
         if Empty(xPath)
            Return (.t.)
         end

         if Right(xPath,1) != '\'
            xPath += '\'
         end
         if aIn[28] == 1 // BestPRN
            lRet := ValidPath(xPath)
            elseif aIn[28] == 2 // Генератор отчетов для Windows
                   if !(lRet := File(xPath + 'RepTasks.dbf'))
                      SayError('Файл обмена не найден !')
                   end
         end

Return (lRet)
//
Static Function MakeRWP(xPath)
xPath := AllTrim(xPath)
         if Empty(xPath)
            Return (.t.)
         end
         if Right(xPath,1) != '\'
            xPath += '\'
         end

 if File(xPath+'PrnList.dbf')
    dbPush()
    NetUse( "PrnList", xPath+'PrnList.dbf')
    PrnList->(MakeRefer("RefRWP","[ Справочник принтеров ]",2,;
    {"Название принтера"},;
    {4,34,12},COL_REFER,{"PrnList->PRINTER"},{"aIn[29]"},,;
    {{||Left(PrnList->Printer,40)}},;
    ,;
    ,,,,,,,,,,'F2:Справочник принтеров',,,,,'cFind$UPPER(TRIM(PrnList->PRINTER ))' ))
    dbPop()
 end
Return .t.

/*
  Процедура редактирования управляющих символов для печати
  иcпользует CURR_PRINTER (C) в качестве внешней переменной

*/
FUNCTION UprSimv
   PARAMETERS nField
   LOCAL nTop := 04, nBottom := 21, aSet := SaveSet(), aSetKeys := SaveSetKey()
      LOCAL cBoxFoot := ;
'+:Редакт  F4:Добавить  F6:Фильтр F8:Удалить  F9:Печать'
   LOCAL cColHead := ;
  " Код       Наименование            Управляющий символ              "
*  12345 1234567890123456789012345 12345678901234567890123456789012345
*  12345678901234567890123456789012345678901234567890123456789012345678901234567890
*          10        20        30        40        50        60        70

   LOCAL aBlockCols := {;
    {{|| FIELD->CODE},                 1 },;
    {{|| FIELD->NAME},        7 },;
    {{|| LEFT(FIELDGET(nField),35)}, 33 } ;
                                           }

   LOCAL cCurProc

    LOCAL aHeads := {;
          {"Код...............:", "CODE"},;
          {"Наименование......:", "NAME"},;
          {"Управляющий символ:",  FIELDNAME(nField) };
                                          }

   LOCAL aRef

   LOCAL aPict:={,,'@KS35'}

   LOCAL aWhen

   LOCAL aValid

   LOCAL nUniMode := 0

   LOCAL bDelInit

   LOCAL bScrInit

   LOCAL aSortSeek

   LOCAL aPrint
   LOCAL aPrintHeads:= { 'Коды принтера', {'Код','CODE'},;
                       {'Наименование','NAME'},;
                       {'Управляющий символ',FIELDNAME(nField), REPLICATE('X',35)} }
   LOCAL bPost

   MEMVAR NAME_DBF

   Help_Code := '07'

   ScrMain()
   SETCOLOR(COL_INPUT)
   ScrTitul(01,"НАСТРОЙКА КОМПЛЕКСА")
   ScrTitul(24,cBoxFoot)

   IF FieldPos("PLOT"+NTOC(nField-2)) != 0
     AADD(aHeads,{"Плотность символов:",  "PLOT"+NTOC(nField-2) })
   ENDIF

   SETCOLOR(COL_BROWSE)
   ShadowBox("[ Настройка кодов принтера: "+ALLTRIM(FCPRINT->NAME) +" ]",nTop-01,05,nBottom+01,75,COL_BROWSE)

       // Обращение к основной процедуре
    InitList(nTop,nBottom,cColHead,aBlockCols,cCurProc,;
      aHeads,aRef,aPict,aWhen,aValid,nUniMode,bDelInit,bScrInit,aSortSeek,;
      aPrintHeads,bPost)

 aIn[7] := .F.
 RestSet(aSet)
 RestSetKey(aSetKeys)
 CLEAR TYPEAHEAD

RETURN (.F.)
********************************************************************
FUNCTION ValidPath( cPath, cFile )
  LOCAL lRez := .T., nRez, ;
        cOldPath := DIRNAME(),;
        cOldDisk := DISKNAME(), cDisk := DISKNAME()
  cPath := ALLTRIM( cPath )
  IF !EMPTY(cPath)
    nRez := AT( ':', cPath )
    IF nRez<>0
      cDisk := LEFT( cPath, nRez-1 )
    ENDIF
    IF DISKCHANGE( cDisk )
      if IsMsNT()
         if Right(cPath,1) == '\'
           cPath := Left(cPath,Len(cPath)-1)
         end
      end
      nRez := DIRCHANGE( cPath )
      IF nRez <> 0
        lRez := .F.
        IF nRez == -3
          SayError( 'Неправильно указан путь !' )
        ELSEIF nRez == -5
          SayError( 'Отказ в доступе!' )
        ENDIF
      ELSEIF !EMPTY(cFile)
             cFile := AllTrim(cFile)
             IF !FILE( cFile )
                 SayError( 'Файл '+cFile+' не найден !' )
             ENDIF
      ENDIF
    ELSE
      SayError( 'Неправильно указан диск!' )
      lRez := .F.
    ENDIF
  ENDIF
  DISKCHANGE( cOldDisk )
  DIRCHANGE( cOldPath )
RETURN( lRez )

Function IsLinux()
#ifdef __PLATFORM__Linux
Return .t.
#else
Return .f.
#endif
//
Function IsAds()
Return .F. //RDDSetDefault() == 'ADS'


/********************************

Function IsAdsConnected()
Local nConnect := ADSGetConnectionType()
Return ( nConnect == 1.or.nConnect == 2 )
//
Function _Array2ADS( xValue )
Local cSerial
Local xElement,xTmp
Local cType := ValType( xValue )
      switch cType
            case 'A'
                 cSerial := cType+HexZero(Len(xValue))
                 for each xElement in xValue
                     cSerial += _Array2ADS( xElement )
                 next
                 exit
            case 'M'
            case 'C'
                 cSerial := cType+HexZero(Len(xValue))+xValue
                 exit
            case 'N'
                 xTmp := AllTrim(Str(xValue))
                 cSerial := cType+HexZero(Len(xTmp))+xTmp
                 exit

            case 'D'
                 cSerial := cType+DTOS(xValue)
                 exit
            case 'L'
                 cSerial := cType+if(xValue,'T','F')
                 exit

            case 'U'
            case 'B'
            case 'O'
                 cSerial := cType
                 exit
      end
Return cSerial

Function _ADS2Array( cStr )
Local uRet
Local i := 1
Local cType
Local nLen,nDepth


      cType := cStr[i++]
      switch cType
          case 'A'
               nLen := HB_HexToNum(SubStr(cStr,i,4))
               i += 4
               cStr := SubStr(cStr,i)
               uRet := {}
               While nLen > 0
                     aadd(uRet,_ADS2Array( @cStr ))
                     nLen--
               enddo
               exit
          case 'C'
          case 'M'
               nLen := HB_HexToNum(SubStr(cStr,i,4))
               i += 4
               uRet := SubStr(cStr,i,nLen)
               i += nLen
               cStr := SubStr(cStr,i)
               exit
          case 'N'
               nLen := HB_HexToNum(SubStr(cStr,i,4))
               i += 4
               uRet := Val(SubStr(cStr,i,nLen))
               i += nLen
               cStr := SubStr(cStr,i)
               exit
          case 'L'
               uRet := cStr[i] == 'T'
               i += 1
               cStr := SubStr(cStr,i)
               exit
          case 'U'
               uRet := NIL
               cStr := SubStr(cStr,i)
               exit
          case 'D'
               uRet := STOD(SubStr(cStr,i,8))
               i += 8
               cStr := SubStr(cStr,i)
               exit
      end
Return uRet


Static Function HexZero(n)
Return Padl(HB_NumToHex(n),4,'0')


Function Array2ADS( xValue )
Return CHR(6)+_Array2ADS( xValue )

Function ADS2Array( cStr )
Return _ADS2Array( cStr )

*******************************/



FUNCTION DicIndexCreate(cName1,cName2,lClose)
LOCAL nArea:=SELECT()
IF lClose==NIL
   lClose:=.F.
ENDIF
FERASE(cName1+".cdx")
SetCPXXOne(cName1+'.dbf')
NetUseExc("Tables",cName1)
INDEX ON UPPER(DirName+TableName) TAG NAME TO (cName1)
INDEX ON UPPER(LEFT(TableAlias,32)) TAG ALIAS TO (cName1)  ADDITIVE
INDEX ON UPPER(Alias_Ru) TAG ALIAS_RU TO (cName1)  ADDITIVE

FERASE(cName2+".cdx")
SetCPXXOne(cName2+'.dbf')
NetUseExc("Fields",cName2)
INDEX ON UPPER(DirName+TableName+FieldName) TAG NAME TO (cName2)
INDEX ON UPPER(DirName+TableName+Name) TAG ALIAS TO (cName2) ADDITIVE
INDEX ON UPPER(DirName+TableName+Alias_En) TAG ALIAS_EN TO (cName2)  ADDITIVE
INDEX ON UPPER(DirName+TableName+Alias_Ru) TAG ALIAS_RU TO (cName2)  ADDITIVE

IF lClose
   Tables->(DbCloseArea())
   Fields->(DbCloseArea())
   SELECT(nArea)
ENDIF




RETURN 2






