************
*

* Программа..:  BEST
* Имя файла..:  UTil.Prg
* Назначение.:  Утилиты начальной настройки
*
******

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

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

#include "achoice.ch"
#include "dbinfo.ch"
#include "dbedit.ch"


#define CR   chr(13)
#define LF   chr(10)
#define CRLF CR + LF



#xtranslate CHRTRAN(<c1>,<c2>,<c3>) => CHARREPL(<c2>,<c1>,<c3>)

STATIC _DBF_PATH := "DBASE\"   // ПУТЬ К БАЗАМ
STATIC _COUNT_LBL := 0         // Количество предприятий


STATIC MayBlock,bPost


#define _DEFAULT_PAROL '~`~`~`~`~`'


FUNCTION Global_Analit( cCode )
IF !EMPTY( cCode ) .AND. LEFT(cCode,1) != "*" .AND. IF(TYPE("nApp") = "N",MemVar->nApp != 0,.T.)
  IF     Global_Analit[1] == 1
    cCode := PADR( ALLTRIM( cCode ), 6, Global_Analit[3] )
  ELSEIF Global_Analit[1] == 2
    cCode := PADL( ALLTRIM( cCode ), 6, Global_Analit[3] )
  ENDIF
ENDIF
RETURN( cCode )

FUNCTION NoLbl()
RETURN( SayError('Введите хотя бы одно предприятие!') )

FUNCTION Count_Lbl()
RETURN(_COUNT_LBL)

FUNCTION LoadPath( cPath )
  LOCAL cOldPath := _Dbf_Path
  IF ValType( cPath ) == "C"
    _Dbf_PATH  := TruePath(cPath)
  ENDIF
RETURN ( cOldPath )

/**********
*  SetBestEnv()
*  Установка системных параметров и среды
***/
FUNCTION SetBestEnv(cPath)
   SET CURSOR OFF          && Убpать куpсоp
   SET WRAP ON             && menu navigation
   SET SCOREBOARD OFF      && Сообщения не выводить
   SET DATE FRENCH         && Фоpмат даты: 00/00/00
   SET CENTURY OFF         && year in small format
   SET DELETED ON          && Hide deleted records
   READEXIT(.T.)           &&  &  exit from GET/READ operators
   SETCANCEL(.T.)          && enable terminateurn to normal after xkey_clear
   SETBLINK(.F.)
   SET MESSAGE TO 24 CENTER
   SETCLEARB(' ')
   SET EPOCH TO 1920  // до этой даты 20.., после этого 19..


   #ifndef _DEBUG
   IF IsMsNt()
      SetMode(25,80)
   ENDIF
   #endif
   SET HARDCOMMIT OFF



   cPath := IIF(cPath==NIL,;
                "DBASE\;DBASE\ARC\",;
                cPath)
   SET( _SET_PATH, cPath )
RETURN NIL


/**********
*  IsBestIni()
*  Проверка файла конфигурации и специальных параметров
*

***/
Function IsBestIni(cTitul,bPathToUser,bOpen0)
//cTitul - заголовок АРМа
//bPathToUser - переменная либо блок, возвращающий путь
//bOpen0 - блок, выполняющийся на фоне главного экрана перед отображением меню
LOCAL lRet := .T.

  SetBestEnv(IF(VALTYPE(bPathToUser)=='B',EVAL(bPathToUser),bPathToUser))
  IsLegal() //!!!!!!!
  lNewFirm := .F.

IF !FILE(LoadPath()+'INI\Global_V.dbf')  .AND.GlobalTask!='10'
   SayError("Выполните настройку системы!")
   lRet := .F.
ELSE

   *  INST_CFG - конфигуpация задачи : стpока символов длиной 25 знаков
   *  Если соответствующий паpаметp задан, то в стpоке 1, иначе - 0
   *  00 Главный модуль
   *  01 Банк
   *  02 Касса
   *  03 Склад
   *  05 Продажи
   *  06 Основные средства
   *  08 Зарплата
   *  09 Производственные запасы
   *  10 Настройка
   *  11 Анализ движения товаров
   *  S1 Учет в розничной торговле (кассовые аппараты)



   SetKey(K_F1     , {||MY_Help( "HELP"+GlobalTask )   })
   SetKey(K_ALT_Z  , {||MAGCALC( ProcName(), ProcLine(), ReadVar() )})
   SetKey(K_ALT_K  , {||Bloknot(03,04,"N/W,N/W,R+/W,W+/N,N/BG" ,GlobalTask)})
   SETKEY( K_ALT_V, {|| Hot_VCurs() } )
  SETKEY (K_CTRL_T, {|| SverkaBas() })

#ifdef __HARBOUR__
//  SETKEY (K_ALT_X, {||NewExportImport()})
IF GETENV('BEST5_ALTINS')=='YES'
   SETKEY( K_ALT_INS, {|| AltIns() } )
ENDIF
#endif

   ScrMain(.T.)
   ScrTitul(1,cTitul)

   * проверить выполнение настройки
   lRet:= GetStatus(bOpen0)
ENDIF
RETURN lRet

*
/**********
*  GetStatus() -> l
*  Выполнена настройка системы? (с проверкой CURR_BREAK)
***/
Function GetStatus(block)
   LOCAL lRet := .T., nSel := SELECT()
   LOCAL aSet := SaveSet(), GetList:={}
   LOCAL cParol, cFile := _NNOPER_INI, nH,dCurr_Prof, bakTask
   LOCAL pw := SPACE(10),;
         cNewClr := 'n/n,n/n*',cArmTask := GlobalTask
   PRIVATE _nNoper := 1

   IF !FILE(LoadPath()+'INI\Global_V.dbf').AND.GlobalTask!='10'
      SayAndWait("Выполните начальную настройку системы!")
      RETURN(.F.)
   ENDIF

   IF cArmTask == '14'  // Пароль на новую зарплату идентичен старой
     cArmTask := '07'
   ELSEIF cArmTask $ 'TV.PD'  // Управление звкупками использует 15 пароль
     cArmTask := '15'
   ELSEIF cArmTask == 'TZ'  // Торговый зал использует 16 пароль
     cArmTask := '16'
   ELSEIF cArmTask == 'EX'  // Модуль обмена данными зал использует 17 пароль
     cArmTask := '17'
      ELSEIF cArmTask == 'CN'  // Расчеты-договоры использует 18 пароль
     cArmTask := '18'
   ELSEIF cArmTask == 'TX'  // Экспорт налоговых форм использует 19 пароль
     cArmTask := '19'
   ENDIF

   IF !EMPTY(INST_PAROL).AND.LEN(INST_PAROL)>VAL(cArmTask)*10+1.AND.;
      !EMPTY((cParol:=SUBSTR(INST_PAROL,10*VAL(cArmTask)+1,10)))
      IF !(cArmTask$'SRZR').AND.!Parol( cParol )
        RETURN(.F.)
      ENDIF
      // ScrMain()
   ENDIF

   // Совместимость с 3.00
   CURR_BCURS := UPPER(CURR_BCURS)
   ATREPL( 'KURS',  CURR_BCURS, 'CURS')
   ATREPL( 'MYLTI', CURR_BCURS, 'MULTY')

   Global_BCURS   :=  &( '{|Curs,Multy| '+CURR_BCURS+ ' }' )  // Расчет курса
   Global_BVSUMMA :=  &( '{|Curs,Multy,Sum| BS_ROUND('+;
                          CURR_BCURS+'*Sum,CURR_MAIN)}' ) // расчет валюты


     CURR_MDATA := CTOD("  /  /  ")
     CURR_LDATA := MAX(CURR_LDATA,CURR_BEG)


/***********************************************************************
Восстановительные работы переведены в индексацию == titov

   IF GlobalTask!='10' .AND. UPPER(LEFT(GlobalTask,1))<>'S' .AND. ; //!!!!!
      GlobalTask <> 'BK'
      // ПРОВЕРКА НОМЕРА ПРОВОДКИ

      IF NetUse( "N_Main",   LoadPath()+"MAIN"   ) .AND.;
         NetUse( "N_ANALIT", LoadPath()+"ANALIT" )    // НУЖЕН ПУТЬ

        StepPlus( cFile, _nNoper, @nH, .T. )
        IF nH > 0
          SELECT N_MAIN
          OrdSetFocus( 'TAG_NNOPER' )
          GO Bottom                                 //
          _nNoper  := N_MAIN->NNOPER
          StepPlus( cFile, _nNoper, nH )
          N_MAIN->( dbCloseArea() )                 // Закрываем MAIN
        ENDIF

        cFile := LOADPATH()+'INI\ANALIT.INC'
        StepPlus( cFile, _nNoper, @nH, .T. )
        IF nH > 0
          SELECT N_ANALIT
          OrdSetFocus( 'OPER_ANAL' )
          GO Bottom                                 //
          _nNoper  := N_ANALIT->NNOPER
          StepPlus(cFile , _nNoper, nH )
          N_ANALIT->( dbCloseArea() )                 // Закрываем analit
        ENDIF

      ELSE
        Error_Use()
        lRet:=.F.
        M_Close_Base({'N_MAIN','N_ANALIT'})
      ENDIF
      SELECT( nSel )
   ENDIF

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


   CURR_DATA:=Date()
   IF (TYPE('CURR_BEG')!='D')
      CURR_BEG:=CURR_DATA
   ENDIF
   IF (TYPE('CURR_PROF')!='D')
      CURR_PROF:=CURR_DATA
   ENDIF
   dCurr_Prof:=CURR_PROF
   IF (TYPE('CURR_MAIN')='L')
      CURR_MAIN:=NIL
   ENDIF
   //Проверка на переиндексацию
   IF GlobalTask!='10'.AND.GlobalTask!='11'.AND. UPPER(LEFT(GlobalTask,1))<>'S' //!!!!!
      #IFNDEF _DEBUG
      IF (!(TYPE('ST_FILE')=='C').AND.!CURR_BREAK).OR.;
         (TYPE('ST_FILE')=='C'.AND.TYPE('CURR_PROF')=='D';
         .AND.CURR_PROF<CURR_DATA)
         lRet:=.F.
         IF TYPE('ST_FILE')=='C'.AND.CURR_PROF == CTOD('01/01/90')
            IF YesOrNo({"Было аварийное прерывание индексации !"},.T.," Продолжить индексацию "," Выйти из программы ")
              bakTask := GlobalTask
              GlobalTask := "10"
              All_Index()
              lRet:=.T.
              CURR_BREAK:=.F.
              CURR_PROF:=IF(TYPE('ST_FILE')='C'.AND.dCurr_Prof == CTOD('01.01.15'),dCurr_Prof,CURR_DATA)
              SaveStatus()
              GlobalTask := bakTask
            ELSE
              QUIT
            ENDIF
         ENDIF
      ENDIF
      #ENDIF
   ENDIF
   IF !lRet.AND.GlobalTask!="11"
      lRet:=.T.
    IF BestActive( '2', LoadPath() ) == '0'
      IF YesOrNo("Рекомендуем провести переиндексацию данных!",.F.;
      ," Реиндексация ",;
       "    Отказ     ").AND.LASTKEY()!=K_ESC
         IF TYPE('ST_FILE')=='C'
            CURR_PROF := CTOD('01/01/90') // На случай аварии
         ENDIF
         SaveStatus()
         All_Index()

         CURR_BREAK:=.F.
         CURR_PROF := IF(TYPE('ST_FILE')='C'.AND.dCurr_Prof == CTOD('01.01.15'),;
         dCurr_Prof,CURR_DATA)
         SaveStatus()
      ELSE
         CURR_BREAK:=!CURR_BREAK
      ENDIF
      BestActive( '4', LoadPath() )
     ELSE
       SayAndWait({"Рекомендуем выйти из программы на других рабочих станциях",;
                   "и провести переиндексацию данных!"})
       CURR_BREAK:=!CURR_BREAK
     ENDIF
   ELSEIF !(TYPE('ST_FILE')=='C') //Если не сеть
      CURR_BREAK := !CURR_BREAK
      SaveBreak()
   ENDIF

   IF ValType(block) == "B"
     EVAL( Block )
   ENDIF
RETURN lRet

/**********
* LoadStatus() -> l
***/
PROCEDURE LoadStatus()
  IF !FILE(LoadPath()+'INI\Global_V.DBF')
    IF FILE(_BEST_INI)
      RESTORE FROM (_BEST_INI) ADDITIVE
      FERASE(_BEST_INI)
    ENDIF
    IF FILE(_BEST_SYS)
      RESTORE FROM (_BEST_SYS) ADDITIVE
      FERASE( _BEST_SYS )
    ENDIF
    SaveStatus(.T.)
    SaveInstBest()
  ELSE
   Glob_Vars( { 'CURR_DATA',   ;
                'CURR_A_BEG',  ;
                'CURR_A_END',  ;
                'CURR_BEG',    ;
                'CURR_END',    ;
                'CURR_BREAK',  ;
                'CURR_MAIN',   ;
                'CURR_PROJE',;
                'CURR_CURS',   ;
                'CURR_BCURS',  ;
                'CURR_KARB',   ;
                'CURR_ZAP',    ;
                'CURR_PROF',   ;
                'CURR_MDATA',  ;
                'CURR_LDATA',  ;
                'CURR_DTIME',  ;
                'CURR_FTIME'   ;
              }, .F., 'INI\Global_V')
   ENDIF
   RETURN

/**********
* SaveStatus() -> l
***/
PROCEDURE SaveStatus( lWtite )
  LOCAL aVar := {{ 'CURR_DATA',   CURR_DATA    },;
                 { 'CURR_A_BEG',  CURR_A_BEG   },;
                 { 'CURR_A_END',  CURR_A_END   },;
                 { 'CURR_END',    CURR_END     },;
                 { 'CURR_BREAK',  CURR_BREAK   },;
                 { 'CURR_MAIN',   CURR_MAIN    },;
                 { 'CURR_PROJE',CURR_PROJE },;
                 { 'CURR_CURS',   CURR_CURS    },;
                 { 'CURR_BCURS',  CURR_BCURS   },;
                 { 'CURR_KARB',   CURR_KARB    },;
                 { 'CURR_ZAP',    CURR_ZAP     },;
                 { 'CURR_PROF',   CURR_PROF    },;
                 { 'CURR_MDATA',  CURR_MDATA},;
                 { 'CURR_LDATA',  CURR_LDATA},;
                 { 'CURR_DTIME',  CURR_DTIME   },;
                 { 'CURR_FTIME',  CURR_FTIME   } ;
              }

//   altd()
   if FILE( LoadPath()+'USNO.VER' ).and.lWtite != NIL
      if Empty(_USN_BEG)
         _USN_BEG := CTOD('01/01/2003')
         AADD( aVar, { 'USN_BEG',_USN_BEG} )
      endif
   endif

	 // Дату пишет только настройка
   IF GlobalTask == '10' .OR. lWtite <> NIL
		 AADD( aVar, { 'CURR_BEG',    CURR_BEG     } )
	 ENDIF

     Glob_Vars( aVar, .T., 'INI\Global_V')
RETURN

PROCEDURE SaveBreak()
   Glob_Vars( { { 'CURR_BREAK',  CURR_BREAK } }, .T., 'INI\Global_V')
RETURN




FUNCTION LoadInstBest()
  LOCAL aVar
  IF !FILE(LoadPath()+'INI\Global_V.DBF')
    IF FILE(_BEST_INI)
      RESTORE FROM (_BEST_INI ) ADDITIVE
      FERASE(_BEST_INI)
    ENDIF
    IF FILE(_BEST_SYS)
      RESTORE FROM (_BEST_SYS ) ADDITIVE
      FERASE( _BEST_SYS )
    ENDIF
    SaveStatus( .T. )
    SaveInstBest()
  ELSE
        aVar := Glob_Vars( { 'FC_0001',      ; // 1
                             'FC_0002',      ;
                             'FC_0003',      ;
                             'FC_0004',      ;
                             'FC_0006',      ; // 5
                             'FC_0007',      ;
                             'FC_0008',      ;
                             'FC_0009',      ;
                             'FC_0010',      ;
                             'FC_0011',      ; // 10
                             'FC_0012',      ;
                             'FC_0013',      ;
                             'FC_0014',      ;
                             'FC_0015',      ;
                             'ITOG_LEN',     ; // 15
                             'ZABALANS_P',   ;
                             'ZABALANS_S',   ;
                             'BEGIN_D_VVOD', ;
                             'END_D_VVOD',   ;
                             'MAIN_VVOD',    ; // 20
                             'EDIT_RUBLI',   ;
                             '41TO41', ;
                             'ANALIT_PREFIKS',;
                             'VERSIA',;
                             'ACC_LEN',;  // 25
                             'PARTFIS',;  // 26
                             'USN_BEG', ;  // 27
                             'JRN_YES',;  // 28
                             'XML_SETUP';  // 29
              }, .F., 'INI\Global_V')
//     altd()
     INST_CFG      := aVar[1]
     INST_PAROL    := aVar[2]
     GlobalDemo    := aVar[3]
     INST_DATE     := aVar[4]
     lIsGlobValuta := IF( ValType(aVar[5])=='L', aVar[5], .T. )
     GlobalValuta  := PADR(IF( ValType(aVar[6])=='C', aVar[6], 'РУБ' ),3)
     Global_Analit := { aVar[7], aVar[8], aVar[9] }
     IF ValType(Global_Set) <> 'A'
        Global_Set := _GLOB_SET_DEF
     ENDIF

     Global_Set[1] :=  IF( VALTYPE(aVar[10])<>'C', '@K ', ALLTRIM(aVar[10]) )
     IF EMPTY(Global_Set[2])
       Global_Set[4] :=  IF( VALTYPE(aVar[11]) <> 'L', .T., aVar[11] )
     ENDIF
     IF !EMPTY( Global_Set[1] )
        Global_Set[1] +=' '
     ENDIF
     Global_Set[5] :=  IF( VALTYPE(aVar[12]) <> 'C', '000', aVar[12] )
     Global_Set[6] :=  IF( VALTYPE(aVar[13]) <> 'L', .F.,   aVar[13] )
     Global_Set[7] :=  IF( VALTYPE(aVar[14]) <> 'C', ' ',   aVar[14] )
     _ITOG_LEN     :=  IF( VALTYPE(aVar[15]) <> 'N', 17,    aVar[15] )
     _ZABALANS_P   :=  IF( VALTYPE(aVar[16]) <> 'L', .F.,   aVar[16] )
     _ZABALANS_S   :=  IF( VALTYPE(aVar[17]) <> 'C', ' ',   aVar[17] )
     _BEGIN_DATE_VVOD  :=  IF( VALTYPE(aVar[18]) <> 'D', CTOD(''),   aVar[18] )
     _END_DATE_VVOD    :=  IF( VALTYPE(aVar[19]) <> 'D', CTOD(''),   aVar[19] )
     _YES_NO_VVOD_MAIN :=  IF( VALTYPE(aVar[20]) <> 'L', .T.,   aVar[20] )
     _YES_NO_RUBLI     :=  IF( VALTYPE(aVar[21]) <> 'L', .F.,   aVar[21] )
     _41to41           :=  IF( VALTYPE(aVar[22]) <> 'L', .F.,   aVar[22] )
     _ANALIT_PREFIKS   :=  ALLTRIM(IF( VALTYPE(aVar[23]) <> 'C', '',   aVar[23] ))
     //_VERSIA           :=  ALLTRIM(IF( VALTYPE(aVar[24]) <> 'C', '',   aVar[24] ))
     _ROZNICA          :=  FILE(LoadPath()+'ROZNICA.TXT').AND.;
                           ("SCLAD.EXE"$ExeName().OR."REAL.EXE"$ExeName().OR."TZ.EXE"$ExeName().OR."REAL.EXE"$ExeName().OR."TOVAR.EXE"$ExeName())
     _DOP_REJ:=OnRej(MyGetID(),SUBSTR(MEMOREAD(_PRO_PATH+'DOPKEY.TXT'),1,10))
     _CN_PRESENT       :=  .T.
     // TAXI
     _TX_PRESENT       :=  .T.
     // и еще в S_PUBLIC исправить
     _LEN_SCHET     := IF( VALTYPE(aVar[25]) <> 'N',10,aVar[25] )   // ACC_LEN
     _PARTFIS       := IF( VALTYPE(aVar[26]) <> 'L', .f.,aVar[26] ) // PARTFIS
     _USN_BEG       := IF( VALTYPE(aVar[27]) <> 'D', CTOD(""),aVar[27] ) // USN_BEG
     _JRN_YES       := IF( VALTYPE(aVar[28]) <> 'L', .f.,aVar[28] ) // JRN_YES
     _XML_SETUP     := IF( VALTYPE(aVar[29]) <> 'C'.OR.EMPTY(aVar[29]).OR.LEN(aVar[29])<30,REPLICATE("0",10)+PADR("0208010406050307",20,"0"),aVar[29]) // XML_SETUP
     _DS_PRESENT    := .T.

     IF( ValType( Global_Set[5]) <> 'C' .OR.;
         LEN(Global_Set[5]) < 3, Global_Set[5] := 'RAR', )
     IF( ValType(Global_Analit[1]) <> 'N', Global_Analit[1]:=0, )
     IF( ValType(Global_Analit[2]) <> 'L', Global_Analit[2]:=.F., )
     IF( ValType(Global_Analit[3]) <> 'C', Global_Analit[3]:= ' ', )
     IF ASC(Global_Analit[3]) == 0
       Global_Analit[3] := ' '
     ENDIF
     IF ASC(Global_Set[7]) == 0
       Global_Set[7] := ' '
     ENDIF
  ENDIF
RETURN NIL

/**********
*  SaveInstBest()
*  Сохранить текущую конфигурацию в файле BestL.SYS
***/
FUNCTION SaveInstBest()
  Glob_Vars( {{ 'FC_0001', INST_CFG       },;
              { 'FC_0002', INST_PAROL     },;
              { 'FC_0003', GlobalDemo     },;
              { 'FC_0004', INST_DATE      },;
              { 'FC_0006', lIsGlobValuta  },;
              { 'FC_0007', GlobalValuta   }, ;
              { 'FC_0008', Global_Analit[1] }, ;
              { 'FC_0009', Global_Analit[2] }, ;
              { 'FC_0010', Global_Analit[3] }, ;
              { 'FC_0011', Global_Set[1] },    ;
              { 'FC_0012', Global_Set[4] },    ;
              { 'FC_0013', Global_Set[5] },    ;
              { 'FC_0014', Global_Set[6] },    ;
              { 'FC_0015', Global_Set[7] },    ;
              { 'ZABALANS_P', _ZABALANS_P },   ;
              { 'ZABALANS_S', _ZABALANS_S },   ;
              { 'BEGIN_D_VVOD',_BEGIN_DATE_VVOD }, ;
              { 'END_D_VVOD',  _END_DATE_VVOD   }, ;
              { 'MAIN_VVOD',   _YES_NO_VVOD_MAIN}, ;
              { 'EDIT_RUBLI',  _YES_NO_RUBLI    },  ;
              {'41TO41',_41to41},;
              {'ANALIT_PREFIKS',_ANALIT_PREFIKS},;
              {'ACC_LEN',_LEN_SCHET},;
              {'PARTFIS',_PARTFIS},;
              {'USN_BEG',_USN_BEG}, ;
              {'JRN_YES',_JRN_YES}, ;
              {'XML_SETUP',_XML_SETUP};
              }, .T., 'INI\Global_V')
RETURN NIL

*******************************************************
PROCEDURE LoadLabel( cPath, aLogin, lNo, lNoVvod, lShop,cCodePr)  // пакетный режим victor 2
//cCodePr - Если код предприятия передан и он в точности совпадает с карточкой предприятия, то запроса на выбор предприятия не будет
  LOCAL nMax:=0,;
         cScreen, cTmpPath,i, cNewParol:='',;
         lSay := .T.
  Local nCnt,cColor,cColor1
  Local uDir,uName,uExt
  LOCAL lYesBase := .F.   // пакетный режим victor   признак, что переданный путь найден
  PRIVATE aLabel := {{},{},{},{},{}}
   // Для некоторых армов непоказываем некоректные пути
   IF AT( 'SCLADR.EXE',      EXENAME() ) <> 0  .OR. ;
      AT( 'ZAPASR.EXE',      EXENAME() ) <> 0
     lSay := .F.
   ENDIF
   cPath := IF( ValType( cPath ) <> 'C', '', ALLTRIM(cPath) )
   IF FILE(IF(EMPTY(lShop),_PRO_PATH+'LABEL.PRO',LoadPath()+'PATHSHOP.PRO'))

     USE  (IF(EMPTY(lShop),_PRO_PATH+'LABEL.PRO',LoadPath()+'PATHSHOP.PRO'));
          ALIAS LABEL SHARED NEW VIA 'DBFCDX'
     IF !USED()
       SayError( 'Ошибка открытия '+IF(EMPTY(lShop),'Label.PRO','PathShop.PRO') )
       QUIT
     ENDIF
     _COUNT_LBL := 0
     dbEVAL( {|| cTmpPath := ALLTRIM(LABEL->LBL_PATH),;
                 IF( cTmpPath==cPath .AND. !lYesBase, nMax := _COUNT_LBL+1,),;     // пакетный режим victor 2
                 IF(HB_IT_CHAR(cCodePr).and.ALLTRIM(UPPER(ALLTRIM(LABEL->LBL_CODE)))==ALLTRIM(UPPER(cCodePr)),(lYesBase:=.T.,nMax := _COUNT_LBL+1),),;
                 cTmpPath := IF( FIELDPOS('LBL_REM')>0.AND.!EMPTY(LABEL->LBL_REM),;
                                 LABEL->LBL_REM,;
                                 IF( LEN(cTmpPath)>22 , ;
                                     ' ... '+RIGHT(cTmpPath,17),;
                                     PADR(cTmpPath,22) )+ '  '+ LABEL->LBL_NAME),;
                 IF( lSay .OR. MyCode(ALLTRIM(LABEL->LBL_PATH),,@cNewParol,lShop),;
                    (cNewParol:='',;
                     AADD( aLabel[1], cTmpPath ),;
                     AADD( aLabel[2], RecNo() ),                    ;
                     AADD( aLabel[3], MyCode(ALLTRIM(LABEL->LBL_PATH),,@cNewParol,lShop) ),    ;
                     AADD( aLabel[4], cNewParol ),;
                     AADD( aLabel[5], ALLTRIM(LABEL->LBL_PATH) ),;
                     cNewParol:='',                    ;
                     _COUNT_LBL++ ;
                    ),;
                   );
             },{||!Deleted() .AND. ;
                  IF( EMPTY(aLogin), .T., ;
                                      ASCAN(aLogin, {|x|x[1]==UPPER(LABEL->LBL_CODE)})<>0 ) } )


#IFNDEF _DEBUG
     // Проверим версии баз
     For nCnt := 1 to Len(aLabel[5])
         if !SverkaVersion( _CURRENT_VER, '', aLabel[5][nCnt] )
            aLabel[3][nCnt] := .f.
         endif
     next
#ENDIF




     IF lNo <> NIL
       LABEL->( dbCloseArea() )
       RETURN
     ENDIF

     IF _COUNT_LBL > 1
       IF nMax == 0 .OR. ;
            EMPTY( lNoVvod ) .OR. ;
            !aLabel[3][nMax] .OR. ;
            (_MENU_YES .AND. !lYesBase)          // пакетный режим victor
         IF( nMax==0, nMax := 1, )
         cScreen := SAVESCREEN(0,0,24,79)
         cColor:="B/W*,W+/B,,,R/W*" //,"B/W*"
         cColor1:="B/W*"

         nMax :=BoxMenu("╡ Выберите "+IF(EMPTY(lShop),"предприятие","магазин")+" ╞",4,8,     ;
                       aLabel[1],                    ;
                       aLabel[3],                          ;
                       nMax,,cColor,cColor1,,;
                       MIN( 5+LEN(aLabel[1]),  18 ), ;
                       .T.   ;
                       )
          RESTSCREEN(0,0,24,79,cScreen)
          IF nMax == 0
            IF ( AT( 'INIT.EXE', EXENAME() ) <> 0 )
              IF LASTKEY()==K_ESC
                 QUIT
              ELSE
                 LABEL->( dbCloseArea() )
                 RETURN
              ENDIF
            ELSEIF ASCAN( aLabel[3], .T.  ) == 0
              SayError({'Неправильно указан путь к базам ',;
                       'или противоречивая маркировка версий!'})
            ENDIF
            QUIT
         ENDIF
       ENDIF

    ELSEIF _COUNT_LBL == 0
         IF ( AT( 'INIT.EXE', EXENAME() ) <> 0 )
           LABEL->( dbCloseArea() )
           RETURN
         ELSE
           SayError( 'Выполните начальную настройку системы!' )
           QUIT
         ENDIF
    ELSE
     nMax := 1
    ENDIF
       // ПРОВЕРКА ДОСТУПА
       dbGOTO( aLabel[2][nMax] )
       cPath := ALLTRIM(LABEL->LBL_PATH)

        ***** Алексей Катков *****
        IF  FILE(cPath+'MO.TXT')
            _VERSIA := 'МО'
        ENDIF
        /*
        IF  FILE(cPath+"ROZNICA.TXT")
            _IS_ROZNICA:=.T.
        ENDIF
        */
       IF !EMPTY(aLogin)
         i := ASCAN(aLogin, {|x|x[1]==UPPER(LABEL->LBL_CODE)})
         Global_Set[4] := aLogin[i,2]
         Global_Set[26]:= aLogin[i,4]
         _FIRM_CODE    := aLogin[i,1]
         _USER_MENU    := aLogin[i,3]
       ENDIF
       IF(!EMPTY(lShop), (m->_PATH_SHOP:= cPath, cPath:= LoadPath()+cPath), )
       IF !FILE( cPath+IF(EMPTY(lShop),'Base_All.DBF','Bases_Mg.DBF') )
         IF ( AT( 'INIT.EXE', EXENAME() ) <> 0 )
           IF(EMPTY(lShop), LoadPath( cPath ), )
           LABEL->( dbCloseArea() )
           RETURN
         ELSE
           SayError( 'Неправильно указан путь!' )
           QUIT
         ENDIF
       ENDIF

       IF(EMPTY(lShop), SavePathStation( cPath ), )

     //ENDIF
     IF(EMPTY(lShop), LoadPath( cPath ), )
     IF BestActive( '1', LoadPath() ) <> '0'
        SayAndWait( {'Идет индексация баз данных на другой рабочей станции'} )
        QUIT
     ENDIF
     LBL_POZ   := LABEL->(RECNO())
     LBL_NAME  := ALLTRIM(LABEL->LBL_NAME)
     LBL_SHEF  := ALLTRIM(LABEL->LBL_SHEF)
     LBL_BOSS  := ALLTRIM(LABEL->LBL_BOSS)
     LBL_ADRES := ALLTRIM(LABEL->LBL_ADRES1)+ALLTRIM(LABEL->LBL_ADRES2)
     LBL_INDEKS:= ALLTRIM(LABEL->LBL_INDEKS)
     LBL_TEL   := LABEL->LBL_TEL
     LBL_FAX   := LABEL->LBL_FAX
     LBL_OKPO  := LABEL->LBL_OKPO
     IF LABEL->(FIELDNUM('LBL_CODE'))>0
        LBL_CODE  := LABEL->LBL_CODE
     ENDIF
     IF LABEL->(FIELDNUM('LBL_SHEF2'))>0
       LBL_SHEF2  := ALLTRIM(LABEL->LBL_SHEF2)
       LBL_BOSS2  := ALLTRIM(LABEL->LBL_BOSS2)
     ENDIF
     IF LABEL->(FIELDNUM('LBL_OPER')) > 0
       LBL_OPER  := LABEL->LBL_OPER
     ENDIF
     IF LABEL->(FIELDNUM('LBL_WPPATH')) > 0
       m->LBL_WPPATH  := LABEL->LBL_WPPATH
     ENDIF
     IF LABEL->(FIELDNUM('LBL_ORG')) > 0
        m->LBL_ORGNAME  := LABEL->LBL_ORG
        m->LBL_BANK  := LABEL->LBL_BANK
        m->LBL_RECV  := LABEL->LBL_RECV
        m->LBL_BNKKOD:= LABEL->LBL_BNKKOD
        m->LBL_RSCHET:= LABEL->LBL_RSCHET
        m->LBL_CORR:= LABEL->LBL_CORR
        m->LBL_INNKPP:= LABEL->LBL_INNKPP
        m->LBL_ADRESF := ALLTRIM(LABEL->LBL_ADRESF)
        m->LBL_TEL2   := LABEL->LBL_TEL2
     ENDIF

     LABEL->( dbCloseArea() )
     IF !FILE(LoadPath()+'Base_all.DBF').OR.;
        (!EMPTY(lShop).AND.!FILE(cPath+'Bases_MG.DBF'))
       SayError( 'Неправильно указан путь!' )
       QUIT
     ENDIF

     _IS_BUDGET := FILE( LoadPath()+'BUDGET.VER' ) // Признак бюджетной базы
     _IS_USN    := FILE( LoadPath()+'USNO.VER' )  // Признак УСН базы

#ifndef __PLATFORM__Linux

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

     // Определим основной драйвер
     RDDSetDefault( if(File(LoadPath()+'ads.ads'),'ADS','DBFCDX'))
     If IsAds()
        // Всегда создавать новое подключение
        // при смене предприятия
        if IsAdsConnected()
           AdsDisconnect()
        endif
         GlobalTmpPath := LoadPath()+'TMP\'

        //ADSIsServerLoaded(LoadPath())

        if !ADSConnect( LoadPath() )
           SayError({'Не активирован сетевой Advantage Database Server !'})

           hb_FNameSplit( ExeName(), @uDir, @uName, @uExt )
           if file( uDir + 'adsloc32.dll' ).and.YesOrNo({'Продолжить работу с локальным',;
                       'Advantage Database Server ?'})
              AdsSetServerType ( 1 )
              if !ADSConnect( LoadPath() )
                 SayError({'Не активирован локальный Advantage Database Server !'})
                 Quit
              endif
             else
              Quit
           endif
        endif

        if Val(ADSVersion()) < 7.10
           SayError({'Версия '+ADSVersion()+' Advantage Database Server !',;
                     'Не поддерживается !'})
           Quit
        endif
     Else

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

        GlobalTmpPath := B4_GetTempPath()
        GlobalTmpPath += IIf(Right(GlobalTmpPath,1) != '\','\',"")
//     EndIf
#else
     rddSetDefault( 'DBFCDX')
     GlobalTmpPath := B4_GetTempPath()
     GlobalTmpPath += IIf(Right(GlobalTmpPath,1) != '\','\',"")
#endif

     LoadStatus()
     LoadInstBest()

     IF ASCAN( DIRECTORY( LoadPath()+if(IsLinux(),'*','*.*'), 'D'), {|x| ALLTRIM(UPPER(x[1]))=='TMP'} ) == 0
       IF DIRMAKE(LOWER( LoadPath()+"TMP" )) <> 0
         SayError( 'Нет директории: '+LoadPath()+"TMP\" )
         QUIT
       ENDIF
     ENDIF
   ENDIF
RETURN

FUNCTION LBL_FUN( nVid, nElem, nRow )
  LOCAL nRez := 2
  MEMVAR aLabel
    IF LASTKEY() == K_ENTER
      nRez := 1
    ELSEIF LASTKEY() == K_ESC
      nRez := 0
    ELSEIF nElem > 0
      @ 22,01 SAY PADC(aLabel[3,nElem],78)
    ENDIF
RETURN(nRez)

// Запись, проверка кода администратора
FUNCTION  MyCode( cPath, cOldParol, cNewParol, lShop, lWrite )
  LOCAl lRez, cOldCode1:='', cOldCode2:=''
  IF EMPTY(lShop)
     lRez := FILE( cPATH+'Base_All.DBF')
  ELSE
     lRez := FILE( LoadPath()+cPath+'Bases_MG.DBF')
     cPath:= LoadPath()
  ENDIF
  cNewParol:= ''
  IF lRez
   IF EMPTY( lWrite )
      IF !FILE( cPath+'PART.FRM')
        IF c_My_Code <>  _DEFAULT_PAROL
          MEMOWRIT( cPath+'PART.FRM', c_My_Code )
        ENDIF
      ELSE
        cOldCode1 := MEMOREAD( cPath+'PART.FRM' )
      ENDIF
      IF !FILE( cPath+'INI\BK.GRT')
        IF c_My_Code <>  _DEFAULT_PAROL
          MEMOWRIT( cPath+'INI\BK.GRT', c_My_Code )
        ENDIF
      ELSE
        cOldCode2 := MEMOREAD( cPath+'INI\BK.GRT' )
      ENDIF

      IF !EMPTY( cOldCode1 + cOldCode2 ) .AND. ;
         !(cOldCode1== c_My_Code .AND. cOldCode2==c_My_Code )
         // вернем по ссылке, будем использовать при доступе
         cNewParol:= cOldCode1+IF( cOldCode1==cOldCode2, '', cOldCode2 )
      ENDIF

    //
    ELSE
      IF !FILE( cPath+'PART.FRM') .OR. ;
          EMPTY(MEMOREAD( cPath+'PART.FRM' )).OR. ;
          MEMOREAD( cPath+'PART.FRM' ) == cOldParol .OR. ;
          MEMOREAD( cPath+'PART.FRM' ) ==  _DEFAULT_PAROL
        MEMOWRIT( cPath+'PART.FRM', c_My_Code )
      ENDIF
      IF !FILE( cPath+'INI\BK.GRT') .OR. ;
          EMPTY(MEMOREAD( cPath+'INI\BK.GRT' )).OR. ;
          MEMOREAD( cPath+'INI\BK.GRT' )== cOldParol .OR. ;
          MEMOREAD( cPath+'INI\BK.GRT' )== _DEFAULT_PAROL
        MEMOWRIT( cPath+'INI\BK.GRT', c_My_Code )
      ENDIF
    ENDIF
  ENDIF
RETURN( lRez )


Function IsBudget()
Return (_IS_BUDGET)


/**********
*  StepPlus()
*  Определить следующую проводку в MAIN
*  файл должен быть открыт с индексом NNMAIN
*  Новый вариант с 17 разрядным счетчиком:
   - 10 разрядов считается по дисковому счетчику
   - 4 старших разрядов - случайное число в интервале для данной станции
***/
FUNCTION StepPlus( cFile, nNewNnoper, nH, lOpenNoClose )
   LOCAL nI:=300, cBuffer := SPACE(10)
   LOCAL _nNoper := 0
   LOCAL nNoperStop:=1000,cStopBf:=SPACE(10),nHandl

   IF cFile==NIL
      cFile:=LoadPath()+"ini\nnoper.inc"
   ENDIF

   IF nNewNnoper==NIL
      nNewNnoper:=0
   ENDIF





   IF(ValType(nH) = "N",NIL,nH := -1)
   IF( ValType(lOpenNoClose)<>'L',lOpenNoClose:=.F.,)
   IF !FILE( cFile )
     nH :=  FCREATE( cFile, 0 )
     FWRITE( nH, cBuffer, 10 )
     FCLOSE( nH )
     nH := -1
   ENDIF

   IF lOpenNoClose
     nH :=  FOPEN( cFile, 18 )
   ELSE
     DO WHILE --nI > 0
       IF nH > 0 .OR. (nH :=  FOPEN( cFile, 18 )) <> -1  // ТОЛЬКО ДЛЯ ЗАПИСИ и чтения
         BEGIN SEQUENCE
           IF FREAD( nH, @cBuffer, 10 ) < 7  // чтение счетчика (старый == 7)
             SayError( {'Ошибка чтения счетчика '+cFile})
             BREAK
           ELSE
             _nNoper := VAL( cBuffer )
             IF nNewNnoper > 0  //  если надо корректировка значения счетчика
               nNewNnoper:=VAL(RIGHT(STR(nNewNnoper,17,0),10))
               IF nNewNnoper > _nNoper
                 _nNoper := nNewNnoper
               ELSE
                 BREAK
               ENDIF
             ELSE
               _nNoper++
             ENDIF

             IF STR( _nNoper, 10 )  > '9999999999'
               _nNoper := 1  // Начнем с начала, если надо
             ENDIF
             cBuffer := STR( _nNoper, 10 )
             FSEEK( nH, 0 )  // В начало файла
             IF FWRITE( nH, cBuffer, 10 ) < 10 // cброс счетчика на диск
               SayError( {'Ошибка записи'} )
               BREAK
             ENDIF
           ENDIF
         END SEQUENCE
         FCLOSE( nH )
         EXIT
       ENDIF
       INKEY( 0.1 )
     ENDDO
     IF nH == -1
       SayError( "Ошибка записи файла" )
     ELSEIF _nNoper == 0
       SayError( "Проблемы с сетью!" )
     ENDIF
   ENDIF
RETURN VAL(Str(ROUND(HB_Random(1,9999),0),4,0)+STRTRAN(STR(_nNoper,10,0)," ","0"))


******************
FUNCTION altIns()
******************
/* Управляющие клавиши
Основной режим:
  База
     Просмотр - Enter
     Фильтр - Alt-F
     Scope - Alt-O
     Cвязи между базами - Alt-R
     Индексы - Alt-I
     Структура - Alt-S
  Выполнить - ALT-P
  Система
     Стек вызовов - Alt-Q
     Установки системы - Alt-U
     Посмотреть выражения - Alt-W
              Удалить строку - F8
              Добавить строку - F4
  Установки задачи - ALT-X
Просмотр баз
   Работа со столбцами - ALT-T
       Удалить - F8
       Добавить - K_F4
       Закончить с сохранением результата - TAB
 */
LOCAL aBase:={},cAlias:=ALIAS(), nAl:=1
LOCAL nWin := WSELECT(0), nDisp:=DISPCOUNT()
LOCAL aSet := {SaveSetKey(),SaveSet()},i
LOCAL nLastKey :=LASTKEY()
STATIC aStVir:={}
PARAMETERS aParam
//WSELECT(0)
FOR i=1 to nDisp
   DISPEND()
NEXT
dbPush()
WorkSpaceEval({||AADD(aBase,PADR(ALIAS()+IF(Alias()==cAlias,(nAl:=LEN(aBase)+1,' !!!'),''),12))})
DISPBOX(0,0,7,13,2,'w+/b')
@0,1 SAY ' Откр.базы ' COLOR 'w+/b'
cColor:=SETCOLOR('w+/b,w/n')
/*ClearButtons()
AddButton('База')
AddMenu('Просмотр'+ chr(9)+ "Enter",K_ENTER,,'Просмотр таблицы (ENTER)')
AddMenu('Фильтр' + chr(9)+ "Alt-F",K_ALT_F,,'Просмотр фильтра (Alt-F)')
AddMenu('Scope' + chr(9)+ "Alt-C",K_ALT_C,,'Просмотр scope (Alt-C)')
AddMenu('Cвязи между базами' + chr(9)+ "Alt-R",K_ALT_R,,'Просмотр relations (Alt-R)')
AddMenu('Индексы' + chr(9)+ "Alt-I",K_ALT_I,,'Просмотр индексов (Alt-I)')
AddMenu('Структура' + chr(9)+ "Alt-S",K_ALT_S,,'Посмотреть структуру таблицы (Alt-S)')
AddButton('Выполнить',K_ALT_P,,'Выполнить выражение (Alt-P)')
AddButton('Система')
AddMenu('Стек вызовов' + chr(9)+ "Alt-Q",K_ALT_Q,,'Посмотреть стек вызовов (Alt-Q)')
AddMenu('Установки' + chr(9)+ "Alt-U",K_ALT_U,,'Посмотреть Установки системы (Alt-U)')
AddMenu('Выражения' + chr(9)+ "Alt-W",K_ALT_W,,'Посмотреть выражения  (Alt-W)')
AddButton('Задача',K_ALT_X,,'Параметры задачи (Alt-X)')
//AddMenu("Движение по окнам" + chr(9)+ "Tab",K_TAB)
SetButtons()   */
KEYBOARD CHR(K_LEFT)
ACHOICE(1,1,6,12,aBase,,{|nMode,nStr,nPos|myFunc(nMode,nStr,nPos,aBase,@aStVir)},nAl)
SETCOLOR(cColor)

dbPop()
SETLASTKEY(nLastKey)
RestSetKey(aSet[1])
RestSet(aSet[2])
WSELECT(nWin)
FOR i=1 to nDisp
   DISPBEGIN()
NEXT

RETURN .T.

******************
STATIC FUNCTION myFunc(nMode,nStr,nPos,aBase,aStVir)
******************
LOCAL aScope, cIndSc, aBlk:={},cBlk:='', i
LOCAL nReturn := AC_CONT        // default: continues
LOCAL nKey := LASTKEY()
LOCAL aRR, aRes
LOCAL aRasch, xZn
dbPush()
SETCOLOR('w+/b')
DISPBOX(8,0,14,79,1,'w+/b')
DISPBOX(0,14,7,79,1,'w+/b')
@1,15 CLEAR TO 6,78
@9,1 CLEAR TO 13,78
@0,15 SAY ' Связи между базами ' COLOR 'w+/b'
DISPBOX(15,0,24,79,1,'w+/b')
@16,1 CLEAR TO 23,78
@15,2 SAY ' Расчетные параметры ' COLOR 'w+/b'
dbSELECTAREA(aBase[nStr])
aBlk:=dbRLOCKLIST()
FOR i=1 TO LEN(aBlk)
   cBlk+=LTRIM(STR(aBlk[i],10,0))+','
NEXT
cBlk:=LEFT(cBlk,LEN(cBlk)-1)
@9,1 SAY 'ПУТЬ:' COLOR 'GR+/B'
@9,6 SAY PADR(dbInfo(DBI_FULLPATH),73) COLOR 'W+/B'
@10,1 SAY 'N ЗАПИСИ/ВСЕГО:' COLOR 'GR+/B'
@10,16 SAY STR(RECNO(),5,0)+'/'+STR(LASTREC(),5,0) COLOR 'W+/B'
@10,28 SAY 'EOF:' COLOR 'GR+/B'
@10,32 SAY IF(EOF(),'ДА ','НЕТ') COLOR 'W+/B'
@10,36 SAY 'BOF:' COLOR 'GR+/B'
@10,40 SAY IF(BOF(),'ДА ','НЕТ') COLOR 'W+/B'
@10,44 SAY 'БЛОК:' COLOR 'GR+/B'
@10,49 SAY '{'+cBlk+'}' COLOR 'W+/B'
@11,1 SAY 'ИНДЕКС:' COLOR 'GR+/B'
@11,8 SAY PADR(ORDNAME(),10) COLOR 'W+/B'
@11,19 SAY 'КЛЮЧ:' COLOR 'GR+/B'
@11,24 SAY PADR(INDEXKEY(),28) COLOR 'W+/B'
@11,53 SAY 'FOR:' COLOR 'GR+/B'
@11,57 SAY PADR(ORDFOR(),21) COLOR 'W+/B'
@12,1 SAY 'ФИЛЬТР:' COLOR 'GR+/B'
@12,8 SAY PADR(DBFILTER(),71) COLOR 'W+/B'
@13,1 SAY 'SCOPE:' COLOR 'GR+/B'
aScope:=GetScope()
IF VALTYPE(aScope)='A'
   cIndSc:=''
   IF VALTYPE(aScope[5])='A'
      FOR i=1 TO LEN(aScope[5])
         cIndSc+=aScope[5,i]+','
      NEXT
      cIndSc:=LEFT(cIndSc,LEN(cIndSc)-1)
   ENDIF
   @13,7 SAY ScopeMacro()
   DISPOUT(' ИНД:','GR+/B')
   DISPOUT(PADR('{'+cIndSc+'}',79-COL()), 'W+/B')
ELSE
   @13,7 SAY REPLICATE(' ',72)  COLOR 'W+/B'
ENDIF
//arr:=DBRLIST()
aRes:={}
//AEVAL(aRR,{|x,i|AADD(aRes,PADR(ALIAS(DBRSELECT(i)),10)+' '+dBRELATION(i))})
For i=1 to 255     //dbINFO(DBI_CHILDCOUNT)
   IF DBRSELECT(i) = 0
      EXIT
   ENDIF
   AADD(aRes,PADR(ALIAS(DBRSELECT(i)),10)+' '+dBRELATION(i))
Next
IF !EMPTY(aRes)
   FOR i=1 TO LEN(aRes)
      @i,15 SAY PADR(aRes[i],64) COLOR 'W+/B'
   NEXT
ENDIF
aRasch:={}
IF !EMPTY(m->aParam) .AND. VALTYPE(m->aParam)='A'
   FOR i = 1 TO LEN(aParam)
      AADD(aRasch,PADR('Параметр'+LTRIM(STR(i,3,0))+':' + XToStr(aParam[i],,'без переноса строк'),78))
   NEXT
ELSE
   aParam:={}
ENDIF
FOR i = 1 TO LEN(aStVir)
   IF ValidFormula(aStVir[i],@xZn)
      AADD(aRasch,PADR(aStVir[i]+':' + XToStr(xZn,,'без переноса строк'),78))
   ELSE
      AADD(aRasch,PADR(aStVir[i]+': Неправильное выражение' ,78))
   ENDIF
NEXT
FOR i = 1 TO 8
   IF LEN(aRasch)>=i
      @15+i,1 SAY aRasch[i] COLOR 'W+/B'
   ELSE
      @15+i,1 SAY SPACE(78) COLOR 'W+/B'
   ENDIF
NEXT
IF nMode == AC_EXCEPT
   DO CASE
      CASE nKey == K_RETURN
         BrowseBase()
      CASE nKey == K_ALT_P
         RaschVir(@aStVir)
      CASE nKey == K_ALT_Q
         ViewSteck()
      CASE nKey == K_ALT_U
//         ViewSets()
      CASE nKey == K_ALT_R
         ViewRel()
      CASE nKey == K_ALT_I
         ViewInd()
      CASE nKey == K_ALT_S
         ViewSTRUCT()
      CASE nKey == K_ALT_X
  //       ViewTaskInfo()
      CASE nKey == K_ALT_F
         ViewZnach('ФИЛЬТР:'+dbFILTER())
      CASE nKey == K_ALT_O
         ViewZnach('SCOPE:'+XtoStr(GetScope()))
         //ViewZnach('SCOPE:'+ScopeMacro()+chr(13)+chr(10)+'ИНДЕКСЫ:'+XtoStr(GetScope()[5]))
      CASE nKey == K_ALT_W
         ViewVir(aStVir,aRasch)
      CASE nKey == K_ESC
         nReturn := AC_ABORT       // terminate AChoice()
      OTHERWISE
         nReturn := AC_GOTO        // jump to element
   ENDCASE
ENDIF
dbPop()
RETURN nReturn

******************
FUNCTION BrowseBase()
******************
LOCAL aSet := {SaveSetKey(),SaveSet()}
LOCAL nRec := RECNO()
LOCAL aName:={}, aVar:={}, i
STATIC aBasesInfo:={},n,j,aStru

dbPush()
dbGOTO(nRec)
n:=ASCAN(aBasesInfo,{|x|x[1]==ALIAS()})
IF n=0
   AADD(aBasesInfo,{ALIAS(),{},{}})
   n:=LEN(aBasesInfo)
   aStru:=dbSTRUCT()
   FOR i:=1 TO LEN(aStru)
      AADD(aBasesInfo[n,3],PADR(aStru[i,1],MAX(7,LEN(aStru[i,1])))+';'+aStru[i,2]+STR(aStru[i,3],4)+STR(aStru[i,4],2))
      AADD(aBasesInfo[n,2],IF(aStru[i,2]='M',"IIf(Empty("+aStru[i,1]+"),Space(6),'<Memo>')",aStru[i,1]))
   NEXT
ENDIF
SETCOLOR('w+/b')
DISPBOX(8,0,24,79,1,'w+/b')
@9,1 CLEAR TO 23,78
//ClearButtons()
/*AddButton('База')
AddMenu('Фильтр' + chr(9)+ "Alt-F",K_ALT_F,,'Установка фильтра (Alt-F)')
AddMenu('Scope' + chr(9)+ "Alt-C",K_ALT_C,,'Установка scope (Alt-C)')
AddMenu('Cвязи между базами' + chr(9)+ "Alt-R",K_ALT_R,,'Установка relations (Alt-R)')
AddMenu('Индексы' + chr(9)+ "Alt-I",K_ALT_I,,'Установка индексов (Alt-I)')*/
//AddButton('Столбцы',K_ALT_T,,'Столбцы таблицы (Alt-T)')
//SetButtons()
DO WHILE .T.
   CLEAR TYPEAHEAD
   SETLASTKEY(0)
   dbEDIT(9,1,23,78,aBasesInfo[n,2],{|nMode, nColPos|UserEDit(nMode, nColPos,@aBasesInfo)},,aBasesInfo[n,3])
   IF LASTKEY()=K_ESC
      EXIT
   ENDIF
ENDDO

dbPop()
RestSetKey(aSet[1])
RestSet(aSet[2])
RETURN .T.

******************
STATIC FUNCTION UserEdit(nMode, nColPos,aBasesInfo)
******************
  STATIC slAppend:= .F.
      LOCAL nKey    := LastKey()
      LOCAL nReturn := DE_CONT          // default return value
      LOCAL aName, aVar, lAdd:=.F.
      LOCAL n:=ASCAN(aBasesInfo,{|x|x[1]==ALIAS()})
      Local i

      @ 8, 1 SAY PadR('',78, '─' )
      @ 8, 68 SAY PadR( IIf( Deleted()," <удалена> ","") , 11, '─' )
      DO CASE
      CASE nMode == DE_IDLE .OR. ;      // status message below
           nKey  == 255                 // message must be refreshed
                                        // after K_DEL

      CASE nMode == DE_HITTOP           // status message above
         Tone( 1000, 2 )
         @ 8, 50 SAY PadR("<Начало файла>", 14, '─' )

      CASE nMode == DE_HITBOTTOM        // status message above
         /*IF nKey == K_DOWN .AND. ! slAppend
            Tone( 1500 )
            slAppend := .T.
            DbAppend()                  // new record
            @ snTop-1, snLeft+1 SAY ;
              PadR("<New record>", 20, Chr(196) )
            KEYBOARD Chr(K_RETURN)      // switch to edit mode
         ELSE */
            Tone( 500, 2 )

            @ 8,35 SAY PadR("<Конец файла>",13, '─' )
      //   ENDIF

      CASE nMode == DE_EMPTY
         @ 8,50 SAY  PadR("<Пустой файл>", 13, '─')

      CASE nMode == DE_EXCEPT
         DO CASE

        #IFDEF _DEBUG
         CASE nKey == K_ENTER
               aName:={}
               aVar:={}
               FOR i=1 TO FCOUNT()
                  AADD(aName,FIELDNAME(i))
                  AADD(aVar,FIELDGET(i))
               NEXT
               aVar:=DIALOG(aName,,aVar,'Корректировка строки таблицы',,,)
               IF LASTKEY()#K_ESC
                  IF RECLock()
                     FOR i=1 TO FCOUNT()
                        FIELDPUT(i,aVar[i])
                     NEXT
                     dbUnLock()
                  ENDIF
               ELSEIF lAdd
                  IF RecLock()
                     DBDELETE()
                     DBUNLOCK()
                     lAdd:=.F.
                  ENDIF
               ENDIF
               SETLASTKEY(0)
             nReturn := DE_REFRESH
         CASE nKey == K_F8  .AND. RECLOCK()            // (un)delete record
            IF Deleted()
               DbRecall()
            ELSE
               DbDelete()
            ENDIF
            dbUNLock()
            KEYBOARD Chr(255)            // refresh status line

         CASE nKey == K_F4
            AddRec()
            lAdd:=.T.
            KEYBOARD Chr(K_ENTER)
        #ENDIF

         CASE nKey == K_ALT_T
            IzmCol(@aBasesInfo)
            SETLASTKEY(0)
            nReturn := DE_ABORT            // terminate

         CASE nKey == K_ESC              // terminate
            nReturn := DE_ABORT

         /*CASE nKey == K_RETURN           // edit
            SetCursor(1)
            IF Type( FieldName(nColPos) ) == "M"
               EditMemo( nColPos )       // edit memo field
            ELSE
               EditField( saColumns[nColPos] )
            ENDIF
            SetCursor(0)
            slAppend:=.F.
            nReturn := DE_REFRESH*/

         ENDCASE

      ENDCASE

   RETURN nReturn

******************
FUNCTION IzmCol(aBasesInfo)
******************
LOCAL aSet := {SaveSetKey(),SaveSet()}
LOCAL aName:={}, aVir:={} ,i
LOCAL n:=ASCAN(aBasesInfo,{|x|x[1]==ALIAS()})
LOCAL cName, cVir, aRes

FOR i=1 TO LEN(aBasesInfo[n,2])
   AADD(aName,PADR(aBasesInfo[n,3,i],60))
   AADD(aVir,PADR(aBasesInfo[n,2,i],200))
NEXT
DISPBOX(15,9,24,71,2,'w+/b')
  /* ClearButtons()
   AddButton('Удалить',K_F8,,'Удалить столбец (F8)')
   AddButton('Добавить',K_F4,,'Добавить столбец (F4)')
   //AddButton('Переместить',K_F5,,'Переместить столбец (F5)')
   AddButton('Закончить',K_TAB,,'Закончить с сохранением результата (TAB)')
   SetButtons()*/
   DO WHILE LASTKEY() # K_ESC
      i:=ACHOICE(16,10, 23,70,aName,,{|nMode,nStr,nPos|myFunc2(nMode,nStr,nPos)})
      IF LASTKEY() # K_ESC
         DO CASE
            CASE LASTKEY() = K_RETURN       //корректировать
               cName:=aName[i]
               cVir:=aVir[i]
               aRes:=DIALOG({'Заголовок','Выражение'},,{cName,cVir},'Корректировка столбца таблицы',,{,'ValidFormula(xVar[2]).OR.SayError("Неправильное выражение") '},)
               IF LastKey() # K_ESC
                  aName[i]:=aRes[1]
                  aVir[i]:=aRes[2]
               ENDIF
            CASE LASTKEY() == K_F8
                  aDel(aName,i)
                  aSIZE(aName,LEN(aName)-1)
                  aDEL(aVir,i)
                  aSIZE(aVir,LEN(aVir)-1)
            CASE LASTKEY() == K_F4
               cName:=SPACE(60)
               cVir:=SPACE(200)
               aRes:=DIALOG({'Заголовок','Выражение'},,{cName,cVir},'Корректировка столбца таблицы',,{,'ValidFormula(xVar[2]).OR.SayError("Неправильное выражение") '},)
               IF LastKey() # K_ESC
                  aSIZE(aName,LEN(aName)+1)
                  aSIZE(aVir,LEN(aVir)+1)
                  AINS(aName,i)
                  AINS(aVir,i)
                  aName[i]:=aRes[1]
                  aVir[i]:=aRes[2]
               ENDIF
            CASE LASTKEY() == K_F5     //переместить

            CASE LASTKEY() == K_TAB
               aBasesInfo[n,2]:={}
               aBasesInfo[n,3]:={}
               FOR i=1 TO LEN(aName)
                  AADD(aBasesInfo[n,3],ALLTRIM(aName[i]))
                  AADD(aBasesInfo[n,2],ALLTRIM(aVir[i]))
               NEXT
               EXIT
         ENDCASE
      ELSEIF YesOrNo('Изменения не будут сохранены. Продолжить?')
         EXIT
      ENDIF
   ENDDO

RestSetKey(aSet[1])
RestSet(aSet[2])
RETURN .T.

STATIC FUNCTION myFunc2(nMode,nStr,nPos)
******************
LOCAL nRes := AC_CONT        // default: continues
LOCAL nKey := LASTKEY()
LOCAL aRR, xZn
IF nMode == AC_EXCEPT
   DO CASE
      CASE nKey == K_RETURN
         nRes := AC_SELECT
      CASE nKey == K_F8
         nRes := AC_SELECT
      CASE nKey == K_F4
         nRes := AC_SELECT
      CASE nKey == K_F5
         nRes := AC_SELECT
      CASE nKey == K_TAB
         nRes := AC_SELECT
      CASE nKey == K_ESC
         nRes := AC_ABORT       // terminate AChoice()
      OTHERWISE
         nRes := AC_GOTO        // jump to element
   ENDCASE
ENDIF
RETURN nRes



   /*PROCEDURE EditField( cFieldName )

      @ Row(), Col() GET &cFieldName
      READ
   RETURN

   PROCEDURE EditMemo( nFieldPos )
      LOCAL cScreen := SaveScreen()
      LOCAL cText   := FieldGet( nFieldPos )
      DispBox( snTop+2, snLeft+2, snBottom-2, snRight-2 )

      FieldPut( nFieldPos, ;
                MemoEdit( FieldGet( nFieldPos ), ;
                          snTop+3, snLeft+3, snBottom-3, snRight-3 ;

              )         )
      RestScreen(,,,,cScreen)

   RETURN */


******************
FUNCTION ViewInd()
******************
LOCAL cInfo:='', arr:=ORDNAME(),i,n,j

n:=ORDCOUNT()
cInfo+='Открытые индексы таблицы '+ ALIAS() + CHR(13) + CHR(10) + CHR(13) + CHR(10)
FOR i=1 TO n
   cInfo+='ИМЯ:'+ ORDNAME(i) + IF(ORDNAME(i)==arr,'(АКТИВНЫЙ)','') + CHR(13) + CHR(10)
   cInfo+='КЛЮЧ:'+ ORDKEY(i) + CHR(13) + CHR(10)
   cInfo+='УСЛОВИЕ:'+ ORDFOR(i) + CHR(13) + CHR(10) + CHR(13) + CHR(10)
NEXT
IF n = 0
   cInfo+='ТАБЛИЦА НЕ ИМЕЕТ ИНДЕКСОВ'
ENDIF
ViewZnach(cInfo)   ///MEMOEDIT(cInfo,8,0,24,79,.F.)

RETURN .T.

******************
FUNCTION ViewStruct()
******************
LOCAL cInfo:='', arr,i,n,j

arr:=DBSTRUCT()
cInfo+='Структура таблицы '+ ALIAS() + CHR(13) + CHR(10) + CHR(13) + CHR(10)
FOR i=1 TO LEN(arr)
   cInfo+= PADR(arr[i,1],10) + ' ' + arr[i,2] + STR(arr[i,3],4,0) + STR(arr[i,4],3,0) + ' ' + xToStr(FIELDGET(i)) + CHR(13) + CHR(10)
NEXT
ViewZnach(cInfo)   ///MEMOEDIT(cInfo,8,0,24,79,.F.)

RETURN .T.

FUNCTION RelInfo_()
LOCAL aRes :={}, arr,cAl
WorkSpaceEval({||/*arr:=DBRLIST(),*/AADD(aRes,{ALIAS(),{}}), AEVAL(ARRAY(255)/*dbINFO(DBI_CHILDCOUNT)*/,{|x,i|IF(DBRSELECT(i)>0,AADD(ATAIL(aRes)[2],{(cAl:=ALIAS(DBRSELECT(i))),dBRELATION(i),(cAl)->(INDEXKEY())}),NIL)})})
RETURN aRes

******************
FUNCTION ViewRel()
******************
LOCAL cInfo:='', arr,i,n,j
arr:=RelInfo_()
n:=ASCAN(arr,{|x|x[1]==ALIAS()})
IF n>0 .AND. !EMPTY(arr[n,2])
   cInfo+='Установленные связи таблицы '+ ALIAS() + CHR(13) + CHR(10) + CHR(13) + CHR(10)
   FOR i=1 TO LEN(arr[n,2])
      cInfo+='АЛИАС:'+ arr[n,2,i,1] + CHR(13) + CHR(10)
      cInfo+='ВЫРАЖЕНИЕ СВЯЗИ:'+ arr[n,2,i,2] + CHR(13) + CHR(10)
      cInfo+='ИНДЕКС ДОЧЕРНЕЙ ТАБЛИЦЫ:'+ arr[n,2,i,3] + CHR(13) + CHR(10) + CHR(13) + CHR(10)
   NEXT
ENDIF
FOR i=1 TO LEN(arr)
   FOR j=1 TO LEN (arr[i,2])
      IF arr[i,2,j,1] == ALIAS()
         cInfo+='ТАБЛИЦА ЯВЛЯЕТСЯ ДОЧЕРНЕЙ ДЛЯ:'+ arr[i,1] + CHR(13) + CHR(10)
      ENDIF
   NEXT
NEXT
IF EMPTY(cInfo)
   cInfo+='ТАБЛИЦА НЕ ИМЕЕТ СВЯЗЕЙ'
ENDIF
ViewZnach(cInfo)   ///MEMOEDIT(cInfo,8,0,24,79,.F.)
RETURN .T.

******************
FUNCTION ViewTaskInfo()
******************
//LOCAL aSet := {SaveSetKey(),SaveSet()}
LOCAL cInfo:='', cCol, i, xVar
LOCAL aSets:={;
              {'GlobalTask','Код задачи'},;
              {'LoadPath()','Путь к базам'},;
              {'cProPath','Путь к PRO'},;
              {'GlobalTmpPath','Путь к TEMP'},;
              {'cExePath','Путь к EXE'},;
              {'Global_Set[2]','Код оператора'},;
              {'Global_Set[3]','Фамилия оператора'},;
              {'ARM_REC_YES(,GlobalTask)','Запись разрешена?'},;
              {'Global_Set[5] ','Код языка ( "000" - Русский )'},;
              {'Global_Set[6] ','Нужно ли дополнять номера документов'},;
              {'Global_Set[7] ','Символ заполнения номеров документов'},;
              {'Global_Set[9] ','Показывать список предприятий'},;
              {'Global_Set[10]','(.T./.F.)Полнная/Неполная проводка с забалансовыми  счетами'},;
              {'Global_Set[11]','" "-Показывать балансовые "1"-забалансовые "*"-ВСЕ'},;
              {'Global_Set[12]','Длина итоговой суммы'},;
              {'Global_Set[13]','Минимальная дата для ввода'},;
              {'Global_Set[14]','Максимальная дата для ввода'},;
              {'Global_Set[15]','Разрешено прямая коректировка NAIN'},;
              {'Global_Set[16]','Разрешена корректировка рублевых сумм'},;
              {'Global_Set[17]','Разрешо добавление аналитик'},;
              {'Global_Set[18]','Разрешена корреспонденция 41 <--> 41 и тд.'},;
              {'Global_Set[19]','БЭСТ Розница?'},;
              {'Global_Set[20]','префикс для номера аналитик'},;
              {'Global_Set[21]','уникальный номер в STATION.PRO'},;
              {'Global_Set[22]','путь к файлам отчетов'},;
              {'Global_Set[23]','Код варианта меню для пользователя'},;
              {'Global_Set[24]','Код версии'},;
              {'Global_Set[25]','Бюджет?'},;
              {'DATE_CNTRL(m->GlobalTAsk)','Дата разрешения корретировки'},;
              {'Global_Set[27]','Код предприятия'},;
              {'Global_Set[28]','Доп. режимы'},;
              {'Global_Set[29]','Коды доп.режимов'},;
              {'Global_Set[30]','Договор есть?'},;
              {'Global_Set[31]','Длина счета'},;
              {'Global_Set[32]','Партнеры/Физ лица'},;
              {'Global_Set[33]','УСН'},;
              {'Global_Set[34]','Базы УСН'};
             }
//cCol:=SetCOLOR('n/BG,w/n')
FOR i:=1 TO LEN(aSets)
   IF VALTYPE(aSets[i])='A'
      IF VALIDFORMULA(aSets[i,1],@xVar)
         cInfo+=aSets[i,2]+':'+XToStr(xVar,,'без переноса строк')+chr(13)+chr(10)
      ELSE
         cInfo+=aSets[i,2]+':Неизвестное значение'+chr(13)+chr(10)
      ENDIF
   ELSE
      cInfo+=aSets[i]+chr(13)+chr(10)
   ENDIF
NEXT
ViewZnach(cInfo)   ///MEMOEDIT(cInfo,8,0,24,79,.F.)


//SetColor(cCol)
//RestSetKey(aSet[1])
//RestSet(aSet[2])

RETURN .T.

******************
FUNCTION ViewZnach(cStr)
******************
LOCAL aSet := {SaveSetKey(),SaveSet()}
LOCAL nCursor:=SetCursor(1)
LOCAL cCol:=SetCOLOR('n/BG,w/n')
MEMOEDIT(cStr,8,0,24,79,.F.)
SetColor(cCol)
SETCURSOR(nCursor)
RestSetKey(aSet[1])
RestSet(aSet[2])

RETURN .T.

******************
FUNCTION ViewSets()
******************
//LOCAL aSet := {SaveSetKey(),SaveSet()}
LOCAL cInfo:='', cCol, i
LOCAL aSets:={;
'Формат чисел' ,;
{_SET_FIXED     ,'SET_FIXED   '   },;
{_SET_DECIMALS  ,'SET_DECIMALS'   },;
'Формат даты'  ,;
{_SET_CENTURY   ,'SET_CENTURY   ' },;
{_SET_DATEFORMAT,'SET_DATEFORMAT' },;
{_SET_EPOCH     ,'SET_EPOCH     ' },;
{_SET_TIME      ,'SET_TIME      ' },;
"Директории"   ,;
{_SET_PATH      ,'SET_PATH   '    },;
{_SET_DEFAULT   ,'SET_DEFAULT'    },;
"Базы"         ,;
{_SET_EXCLUSIVE ,'SET_EXCLUSIVE'  },;
{_SET_SOFTSEEK  ,'SET_SOFTSEEK '  },;
{_SET_UNIQUE    ,'SET_UNIQUE   '  },;
{_SET_DELETED   ,'SET_DELETED  '  },;
"Клавиатура"   ,;
{_SET_CANCEL    ,'SET_CANCEL   '  },;
{_SET_TYPEAHEAD ,'SET_TYPEAHEAD'  },;
"Экран"        ,;
{_SET_COLOR     ,'SET_COLOR  '    },;
{_SET_CURSOR    ,'SET_CURSOR '    },;
{_SET_CONSOLE   ,'SET_CONSOLE'    },;
"Печать"     ,;
{_SET_ALTERNATE ,'SET_ALTERNATE'  },;
{_SET_ALTFILE   ,'SET_ALTFILE  '  },;
{_SET_DEVICE    ,'SET_DEVICE   '  },;
{_SET_EXTRA     ,'SET_EXTRA    '  },;
{_SET_EXTRAFILE ,'SET_EXTRAFILE'  },;
{_SET_PRINTER   ,'SET_PRINTER  '  },;
{_SET_PRINTFILE ,'SET_PRINTFILE'  },;
{_SET_MARGIN    ,'SET_MARGIN   '  },;
"GET система"  ,;
{_SET_BELL      ,'SET_BELL      ' },;
{_SET_CONFIRM   ,'SET_CONFIRM   ' },;
{_SET_ESCAPE    ,'SET_ESCAPE    ' },;
{_SET_INSERT    ,'SET_INSERT    ' },;
{_SET_EXIT      ,'SET_EXIT      ' },;
{_SET_INTENSITY ,'SET_INTENSITY ' },;
{_SET_SCOREBOARD,'SET_SCOREBOARD' },;
{_SET_DELIMITERS,'SET_DELIMITERS' },;
{_SET_DELIMCHARS,'SET_DELIMCHARS' },;
"Система меню"  ,;
{_SET_WRAP      ,  'SET_WRAP       ' },;
{_SET_MESSAGE   ,  'SET_MESSAGE    ' },;
{_SET_MCENTER   ,  'SET_MCENTER    ' },;
{_SET_CHARSET   ,  'SET_CHARSET    ' },;
{_SET_HANDLEEVENT, 'SET_HANDLEEVENT' },;
'Cравнения'    ,;
{_SET_EXACT     ,'SET_EXACT    '  },;
{_SET_LEXICAL   ,'SET_LEXICAL  '  },;
{_SET_COLLATION ,'SET_COLLATION'  },;
"Устройства вывода" ,;
{_SET_DEVTIMEOUT , 'SET_DEVTIMEOUT'  },;
"Зарезервировано"  ,;
{_SET_ACCELERATORS, 'SET_ACCELERATORS'},;
"Управление цветом" ,;
{_SET_COLORMODE  ,  'SET_COLORMODE'   },;
"Управление оптимизацией" ,;
{_SET_OPTIMIZE   ,  'SET_OPTIMIZE'    },;
"SETs for rushmore optimizer" ,;
{_SET_RUSHMORE   ,  'SET_RUSHMORE'    },;
"SETs for smart filtering" ,;
{_SET_SMARTFILTER , 'SET_SMARTFILTER' }}

//cCol:=SetCOLOR('n/BG,w/n')
FOR i:=1 TO LEN(aSets)
   IF VALTYPE(aSets[i])='A'
      cInfo+=aSets[i,2]+':'+XToStr(SET(aSets[i,1]),,'без переноса строк')+chr(13)+chr(10)
   ELSE
      cInfo+=aSets[i]+chr(13)+chr(10)
   ENDIF
NEXT
ViewZnach(cInfo)//MEMOEDIT(cInfo,8,0,24,79,.F.)


//SetColor(cCol)
//RestSetKey(aSet[1])
//RestSet(aSet[2])
RETURN .T.

******************
FUNCTION ViewVir(aStVir,aRasch)
******************
LOCAL aSet := {SaveSetKey(),SaveSet()}
LOCAL i, xZn , cScr, cCol
Local j

IF LEN(aRasch)=0
   SayError('Нет данных для просмотра')
ELSE
  /* ClearButtons()
   AddButton('Удалить',K_F8,,'Удалить строку (F8)')
   AddButton('Добавить',K_F4,,'Добавить строку (F4)')
   SetButtons()*/
   DO WHILE LASTKEY() # K_ESC
      i:=ACHOICE(16,1, 23,78,aRasch,,{|nMode,nStr,nPos|myFunc1(nMode,nStr,nPos,@aRasch,@aStVir,aParam)})
      IF LASTKEY() # K_ESC
         DO CASE
            CASE LASTKEY() = K_RETURN
               cCol:=SetCOLOR('n/BG,w/n')
               cScr:=SaveSCREEN()
               IF i<=LEN(m->aParam)
                  MEMOEDIT(xToStr(aParam[i]),8,0,24,79,.F.)
               ELSE
                  IF ValidFormula(aStVir[i-LEN(m->aParam)],@xZn)
                     MEMOEDIT(xToStr(xZn),8,0,24,79,.F.)
                  ELSE
                     SayError('Неправильное выражение')
                  ENDIF
               ENDIF
               SetColor(cCol)
               RESTSCREEN(,,,,cScr)
               SETLASTKEY(0)
            CASE LASTKEY() == K_F8
               IF i<=LEN(m->aParam)
                  SayError('Переданные параметры удалять нельзя')
               ELSE
                  aDel(aStVir,i-LEN(m->aParam))
                  aSIZE(aStVir,LEN(aStVir)-1)
                  aDEL(aRasch,i)
                  aSIZE(aRasch,LEN(aRasch)-1)
               ENDIF
               IF LEN(aRasch)>0
                  aRasch:={}
                  IF !EMPTY(m->aParam) .AND. VALTYPE(m->aParam)='A'
                     FOR j = 1 TO LEN(aParam)
                        AADD(aRasch,PADR('Параметр'+LTRIM(STR(j,3,0))+':' + XToStr(aParam[j],,'без переноса строк'),78))
                     NEXT
                  ELSE
                     aParam:={}
                  ENDIF
                  FOR j = 1 TO LEN(aStVir)
                     IF ValidFormula(aStVir[j],@xZn)
                        AADD(aRasch,PADR(aStVir[j]+':' + XToStr(xZn,,'без переноса строк'),78))
                     ELSE
                        AADD(aRasch,PADR(aStVir[j]+': Неправильное выражение' ,78))
                     ENDIF
                  NEXT
               ELSE
                  EXIT
               ENDIF
            CASE LASTKEY() == K_F4
               RaschVir(@aStVir)
               aRasch:={}
               IF !EMPTY(m->aParam) .AND. VALTYPE(m->aParam)='A'
                  FOR i = 1 TO LEN(aParam)
                     AADD(aRasch,PADR('Параметр'+LTRIM(STR(i,3,0))+':' + XToStr(aParam[i],,'без переноса строк'),78))
                  NEXT
               ELSE
                  aParam:={}
               ENDIF
               FOR i = 1 TO LEN(aStVir)
                  IF ValidFormula(aStVir[i],@xZn)
                     AADD(aRasch,PADR(aStVir[i]+':' + XToStr(xZn,,'без переноса строк'),78))
                  ELSE
                     AADD(aRasch,PADR(aStVir[i]+': Неправильное выражение' ,78))
                  ENDIF
               NEXT
         ENDCASE
      ENDIF
   ENDDO
ENDIF

SETLASTKEY(0)
KEYBOARD CHR(255)
RestSetKey(aSet[1])
RestSet(aSet[2])
RETURN .T.

STATIC FUNCTION myFunc1(nMode,nStr,nPos,aRasch,aStVir,aParam)
******************
LOCAL nRes := AC_CONT        // default: continues
LOCAL nKey := LASTKEY()
LOCAL aRR, xZn
IF nMode == AC_EXCEPT
   DO CASE
      CASE nKey == K_RETURN
         nRes := AC_SELECT
      CASE nKey == K_F8
         nRes := AC_SELECT
      CASE nKey == K_F4
         nRes := AC_SELECT
      CASE nKey == K_ESC
         nRes := AC_ABORT       // terminate AChoice()
      OTHERWISE
         nRes := AC_GOTO        // jump to element
   ENDCASE
ENDIF
RETURN nRes


******************
FUNCTION ViewSteck()
******************
//LOCAL aSet := {SaveSetKey(),SaveSet()}
LOCAL cSteck:='',n:=5
LOCAL cCol:=SetCOLOR('n/BG,w/n')
 DO WHILE ! Empty( ProcName(++n) )
    cSteck+= ProcName(n) + "(" + LTrim(Str(ProcLine(n))) + ")" +CHR(13)+CHR(10)
 ENDDO
ViewZnach(cSteck)  //MEMOEDIT(cSteck,8,0,24,79,.F.)
//SetColor(cCol)
//RestSetKey(aSet[1])
//RestSet(aSet[2])

RETURN .T.

******************
FUNCTION RaschVir(aStVir)
******************
LOCAL aSet := {SaveSetKey(),SaveSet()}
LOCAL xRes, lRes:=.F.
LOCAL cCol
STATIC cVir:='                                                                                                                                                                                                                   '
DO WHILE  !lRes
   cCol:=SetCOLOR('n/BG,w/n')
   cVir:=DIALOG('Выражение','@KS60',cVir,'Расчет выражений',,,)
   IF LASTKEY()=K_ESC
      EXIT
   ENDIF
   lRes:=ValidFormula(cVir,@xRes)
   IF !lRes
      SayError('Неправильное выражение')
   ENDIF
ENDDO
IF lRes
   MEMOEDIT(xToStr(xRes),8,0,24,79,.F.)
ENDIF
IF !EMPTY(cVir)
   AADD(aStVir,ALLTRIM(cVir))
ENDIF
//AADD(aStVir,ALLTRIM(cVir))
__KeyBoard(chr(255))
SETLASTKEY(0)
SETCOLOR(cCol)
RestSetKey(aSet[1])
RestSet(aSet[2])
RETURN lRes

******************
FUNCTION xToStr(xVar,cUr,lNoPere)
******************
LOCAL cRes:='', i, mVar
lNoPere:=!EMPTY(lNoPere)
IF cUr = NIL
   cUr :=''
ENDIF
IF LEN(cUr)>10
   cRes:='СЛИШКОМ ГЛУБОКАЯ ВЛОЖЕННОСТЬ'
ELSE
   DO CASE
      CASE xVar = NIL
         cRes+='NIL'
      CASE VALTYPE(xVar)$'C'
         cRes+='C:"'+xVar+'"'
      CASE VALTYPE(xVar)$'M'
         mVar:=/*BIN2Var*/(xVar)
         IF VALTYPE(mVar)='M'
            mVar:=''+mVar
         ENDIF
         cRes+='M:'+xToStr(mVar,cUr,lNoPere)
      CASE VALTYPE(xVar)='D'
         cRes+='D:'+DTOC(xVar)
      CASE VALTYPE(xVar)='N'
         cRes+='N:'+STR(xVar,19,5)
      CASE VALTYPE(xVar)='L'
         cRes+='L:'+IF(xVar,'ДА','НЕТ')
      CASE VALTYPE(xVar)='O'
         cRes+=GetTextObject(xVar,cUr,lNoPere)
      CASE VALTYPE(xVar)='B'
         cRes+='B:{||...}'    //+Var2Char(xVar)
     // CASE VALTYPE(xVar)='M'
     //   cRes+='M:'+xVal
      CASE VALTYPE(xVar)='A'
         cRes+=IF(lNoPere,'A:','')+'{'+IF(lNoPere,'',chr(13)+chr(10))
         FOR i:=1 TO LEN(xVar)
            cRes+=IF(lNoPere,'',cUr+'*')+xToStr(xVar[i],cUr+'*',lNoPere)+IF(lNoPere,',',chr(13)+chr(10))
         NEXT
         IF lNoPere
            cRes:=LEFT(cRes,LEN(cRes)-1)
         ENDIF
         cRes+=IF(lNoPere,'',cUr)+'}'
      OTHERWISE
         cRes+='Неизвестный тип: '+ VALTYPE(xVar)
   ENDCASE
ENDIF
RETURN cRes

******************
FUNCTION GetTextObject(obj,cUr,lNoPere)
******************
LOCAL cRes:=''
LOCAL bError    := ErrorBlock( {|e| Break(e) } )
LOCAL oError
LOCAL cName, aIVars, iMax, i, xVal

BEGIN SEQUENCE
cName:=obj:className()
cRes+=IF(lNoPere,'','')+'O:'+obj:className()+IF(lNoPere,':',chr(13)+chr(10))
aIVars := obj:classDescribe( CLASS_DESCR_MEMBERS )
imax   := Len( aIvars )
ASort( aIVars ,,,{|x,y| Upper( x[CLASS_MEMBER_NAME] ) < ;
                        Upper( y[CLASS_MEMBER_NAME] ) } )

FOR i:=1 TO imax
   cRes+=IF(lNoPere,'',cUr+chr(253))+aIvars[i, CLASS_MEMBER_NAME]+':'
    IF aIVars[i, CLASS_MEMBER_ATTR] == VAR_ASSIGN_HIDDEN
       cRes+= "HIDDEN"
       LOOP
    ENDIF
    IF aIVars[i, CLASS_MEMBER_ATTR] == VAR_ASSIGN_PROTECTED
       cRes+= "PROTECTED"
       LOOP
    ENDIF
/*      cRes+=IF(lNoPere,'A:','')+'{'+IF(lNoPere,'',chr(13)+chr(10))
      FOR i:=1 TO LEN(xVar)
         cRes+=IF(lNoPere,'',cUr+'*')+xToStr(xVar[i],cUr+'*',lNoPere)+IF(lNoPere,',',chr(13)+chr(10))
      NEXT
      IF lNoPere
         cRes:=LEFT(cRes,LEN(cRes)-1)
      ENDIF
      cRes+=IF(lNoPere,'',cUr)+'}'*/
    xVal  := obj:&( aIvars[i, CLASS_MEMBER_NAME] )
    IF UPPER(aIvars[i, CLASS_MEMBER_NAME]) = 'NAME' .AND. VALTYPE(xVal)='A'
      cRes+='A:'+XToStr(xVal,,'без переноса строк')+IF(lNoPere,',',chr(13)+chr(10))
    ELSE
       cRes+=xToStr(xVal,cUr+chr(253),lNoPere)+IF(lNoPere,',',chr(13)+chr(10))
    ENDIF
NEXT
cRes+=IF(lNoPere,'',cUr+'КОНЕЦ ОБЪЕКТА '+cName)

RECOVER USING oError                // error has occurred

cRes:='OBJECT'

END SEQUENCE
ErrorBlock( bError )                // reset error code block

RETURN cRes

******************
FUNCTION GetTextBlock(bl)
******************
LOCAL a
LOCAL bError    := ErrorBlock( {|e| Break(e) } )
LOCAL oError

BEGIN SEQUENCE
     a:=''+bl

RECOVER USING oError                // error has occurred

a:=SUBSTR(oError:operation,AT('{',oError:operation),RAT('}',oError:operation)-AT('{',oError:operation)+1 )

END SEQUENCE
ErrorBlock( bError )                // reset error code block
RETURN a

****************
FUNCTION WorkSpaceEval(bBlock)
****************
LOCAL i
For i=1 TO 255
   IF !EMPTY(ALIAS(i))
      (ALIAS(i))->(EVAL(bBlock))
   ENDIF
Next

RETURN .T.





/*****************************************************************
 FUNCTION: Dialog(cMess,cPict,cVar,cPer)
 Автор..............Панкратов Г.Е.
 Дата...............28.11.97 * 11:25:43
 Назначение.........Функция для внешнего использования
**************************************/
Function Dialog( cMess, cPict, cVar, cZag, cWhen, cValid, cColBox, cRef )
   Local Ret_ := NIL, i,j, lOne:=VALTYPE(cVar)#'A'
   Local nTop, nLeft, nBottom, nRight, nLen
   Local aSet := {SaveSet()}
   Local oGet
   Local S
   Local oObjError
   Local oError
   LOCAL aMess, aPict, aVar, aWhen, aValid
   Private xVar
   Private GetList := {}

   IF cZag == NIL
      cZag := ''
   ENDIF
   nLen := LEN(cZag)+2
   iIF(VALTYPE(cMess)#'A',cMess:={cMess},NIL)
   iIF(VALTYPE(cPict)#'A',cPict:={cPict},NIL)
   iIF(VALTYPE(cVar)#'A',cVar:={cVar},NIL)
   iIF(VALTYPE(cWhen)#'A',cWhen:={cWhen},NIL)
   iIF(VALTYPE(cValid)#'A',cValid:={cValid},NIL)
   cRef := IIF(cRef!=NIL.AND.ValType(cRef) = "C",cRef,Nil)
   IF cMess=NIL
      cMess:=ARRAY(LEN(cVar))
      AFILL(cMess,'Введите значение ')
   ENDIF
   IF cPict=NIL
      cPict:=ARRAY(LEN(cVar))
   ENDIF
   IF cValid=NIL
      cValid:=ARRAY(LEN(cVar))
   ENDIF
   IF cWhen=NIL
      cWhen:=ARRAY(LEN(cVar))
   ENDIF
   IF cColBox = NIL
      cColBox = "N/W"
   ENDIF
   MemVar->xVar:=ARRAY(LEN(cVar))

   IF LEN(cVar)>LEN(cMess)
      aSIZE(cMess,LEN(cVar))
   ENDIF
   IF LEN(cVar)>LEN(cPict)
      aSIZE(cPict,LEN(cVar))
   ENDIF
   IF LEN(cVar)>LEN(cWhen)
      aSIZE(cWhen,LEN(cVar))
   ENDIF
   IF LEN(cVar)>LEN(cValid)
      aSIZE(cValid,LEN(cVar))
   ENDIF
   IF LEN(cVar) >20
      FOR i:=1 TO LEN(cVar) STEP 20
         aMess:={}
         aPict:={}
         aVar:={}
         aWhen:={}
         aValid:={}
         FOR j=i TO MIN(LEN(cVar),i+19)
            AADD(aMess,cMess[j])
            AADD(aPict,cPict[j])
            AADD(aVar,cVar[j])
            AADD(aWhen,cWhen[j])
            AADD(aValid,cValid[j])
         NEXT
         aVar:=DIALOG(aMess, aPict, aVar, cZag+' стр.'+STR(i/20+1,2,0), aWhen, aValid, cColBox )
         IF LASTKEY() = K_ESC
            EXIT
         ELSE
            //altd()
            FOR j=i TO MIN(LEN(cVar),i+19)
               cVar [j]:=   aVar  [j-i+1]
            NEXT
         ENDIF
      NEXT
      Ret_ := ARRAY(LEN(cVar))
      aEVAL(cVar,{|x,i|Ret_[i]:=if(LastKey()<>K_ESC,cVar[i],BLANK(cVar[i],.T.))})
   ELSE
      oObjError := ERRORBLOCK({|Obj|BREAK(obj)})
      Begin Sequence //ANDKOR
         nTop    := INT((MaxRow()-LEN(cVar))/2) - 1
         nBottom := nTop+LEN(cVar) + 1
         FOR i:=1 to LEN(cVar)
            Do Case
               Case ValType(cVar[i])=="C"
                    nLen := MAX(nLen,;
                                Len( cMess[i] ) + if( Empty(cPict[i]),;
                                                     IF(LEN(cVar[i])+Len( cMess[i] )>75,;
                                                        (cPict[i]:='@KS'+TRIM(STR(75-Len( cMess[i] ),2,0)),;
                                                         75-Len( cMess[i] )),;
                                                        LEN(cVar[i])),;
                                                     Len( TransForm(SPACE(200),cPict[i]))) + 3)
               Case ValType(cVar[i])=="D"
                    nLen := MAX(nLen,Len( cMess[i] ) + 11)
               Case ValType(cVar[i])=="N"
                    nLen := MAX(nLen,Len( cMess[i] ) + if( Empty(cPict[i]),(cPict[i]:='9999999999999.99999',19),Len( TransForm(SPACE(200),cPict[i]))) + 3)
               Case ValType(cVar[i])=="L"
                    nLen := MAX(nLen,Len( cMess[i] ) + 4)
            EndCase
         NEXT
   //      nLen    := Len( cMess ) + if( Empty(cPict),nLen,Len( TransForm(SPACE(200),cPict))) + 3
         nLeft   := INT((MaxCol() - nLen)/2)
         nRight  := nLeft + nLen
         SetColor(cColBox)
         ShadowBox(IF(EMPTY(cZag),"",cZag),nTop, nLeft, nBottom, nRight)
         FOR i:=1 to LEN(cVar)
            if( ValType( cMess[i] ) != "C", cMess[i] := "Введите значение", NIL )
            @ nTop+i, nLeft + 2  SAY cMess[i]
            SetCursor(1 )
            MemVar->xVar[i] := cVar[i]
            IF cRef = NIL
              IF EMPTY(cPict[i])
                 @ nTop+i,nLeft+Len(cMess[i])+3 GET MemVar->xVar[i]
              ELSE
                 @ nTop+i,nLeft+Len(cMess[i])+3 GET MemVar->xVar[i] PICTURE cPict[i]
              ENDIF
            ELSE
              IF EMPTY(cPict[i])
                 @ nTop+i,nLeft+Len(cMess[i])+3 REFER cRef GET MemVar->xVar[i]
              ELSE
                 @ nTop+i,nLeft+Len(cMess[i])+3 REFER cRef GET MemVar->xVar[i] PICTURE cPict[i]
              ENDIF
            ENDIF
            if( !Empty( cWhen[i] ), ATAIL(MemVar->GetList):preblock := &('{||'+cWhen[i]+'}'), NIL )
            if( !Empty( cValid[i] ), ATAIL(MemVar->GetList):postblock := &('{||'+cValid[i]+'}'), NIL )
            ATAIL(MemVar->GetList):display()
         NEXT
         READ
         IF lOne
            Ret_:=if(LastKey()<>K_ESC,MemVar->xVar[1],BLANK(MemVar->xVar[1],.T.))
         ELSE
            Ret_ := ARRAY(LEN(cVar))
            aEVAL(cVar,{|x,i|Ret_[i]:=if(LastKey()<>K_ESC,MemVar->xVar[i],BLANK(MemVar->xVar[i],.T.))})
         ENDIF
      Recover USING S  //ANDKOR
      SayError('Ошибка при вводе данных')
      End Sequence //ANDKOR
      ERRORBLOCK(oObjError)
   ENDIF
   RestSet( aSet[1] )

Return Ret_

******************
FUNCTION ValidFormula(cForm,i)
******************
// Проверка правильности формулы
// i - по ссылке возвращает значение вычисления
LOCAL LastHandler, lRet := .T.
   LastHandler:=ERRORBLOCK({|obj|MyHandler(obj)})
   BEGIN SEQUENCE
   i:=&(cForm)
   RECOVER
   lRet:=.F.
//   SayError('Ошибка в фоpмуле или неизвестный параметр!')
   END SEQUENCE
   ERRORBLOCK(LastHandler)

RETURN lRet

STATIC FUNCTION MyHandler()
BREAK
RETURN NIL


FUNCTION VerFromFile(cPath)
LOCAL cVer:=MEMOREAD(cPath),n1,n0,n00,n2slash,n2space
LOCAL cVersion,cModi
n1:=AT(".",cVer)
IF !cVer[n1+1]$"0123456789"
   n1:=AT_(".",cVer,n1+1)
ENDIF
n0:=RAT_(" ",cVer,n1) //- первый пробел после точки слева
n00:=RAT_("/",cVer,n1) //- первый '/' после точки слева
n2slash:=AT_("/",cVer,n1) //- первый '/' после точки справа
n2space:=AT_(" ",cVer,n1) //- первый пробел после точки справа

IF n2slash>n2space
   n2slash:=n2space
ENDIF
n0:=MAX(n0,n00) //- начало
cVersion:=ALLTRIM(SUBSTR(cVer,n0+1,n2slash-n0-1))
cModi:=ALLTRIM(SUBSTR(cVer,n2slash+1,IF(n2space=0,NIL,n2space-n2slash-1)))
//alert(cVersion+"+"+cModi)
RETURN {cVersion,cModi}




FUNCTION SPFromFile(cFile)
LOCAL cBuff:=SPACE(255),aCoord,nSP:=0
LOCAL nH:=FOPEN(cFile,FO_READ)
IF nH > 0
   FRead( nH,@cBuff, 255 )
   aCoord:=SPCoord(cBuff)
   IF !EMPTY(aCoord)
      nSP:=VAL(SUBSTR(cBuff,aCoord[1]+3,aCoord[2]-4))
   ENDIF
   FCLOSE(nH)
ENDIF
RETURN nSP



STATIC FUNCTION SPCoord(cString)
LOCAL aCoord:={0,0}
LOCAL i:=AT("[SP",cString)
LOCAL j:=AT_("]",cString,i)
IF i > 0.AND.j>0.AND.j>i
   aCoord:={i,j-i+1}
ELSEIF IsDigit(SUBSTR(cString,1,1))
   aCoord[1]:=-2
   aCoord[2]:=AT(" ",cString)+3
ELSE
   aCoord:={}
ENDIF
RETURN aCoord





STATIC FUNCTION AT_(c,stri,n)
LOCAL i,nPos:=0
FOR i:=n TO LEN(stri)
IF SUBSTR(stri,i,1)==c
   nPos:=i
   EXIT
ENDIF
NEXT
RETURN nPos


STATIC FUNCTION RAT_(c,stri,n)
LOCAL i,nPos:=0
FOR i:=n TO 1 step -1
IF SUBSTR(stri,i,1)==c
   nPos:=i
   EXIT
ENDIF
NEXT
RETURN nPos




FUNCTION AddReplField(cBase,aPol,aDelArr)
//----------------------------------------------------------------------------//
// Дополняет базу данных полями
// cBase - полное имя файла
// aPol  - массив полей которыми требуется дополнить или скорректировать базу
LOCAL aStruct, cTempFile, cAlias, cTmpAlias
LOCAL nIndik,  bakSelect := SELECT(),n,lGo:=.F.,i, nPosCrc
cAlias:="TTT"

IF(Empty(aDelArr), aDelArr:={}, NIL)

IF("." $ cBase,NIL,cBase += ".DBF")
cBase:=UPPER(cBase)


IF FILE(cBase).AND.NetUseExcA(cAlias,cBase)

   aStruct := dbStruct()
   nPosCrc:=ascan(aStruct,{|x| AT(";"+UPPER(x[1])+";",";CRC;ID_ST;USER_CODE;")>0 })

   FOR i:=LEN(aPol) TO 1 STEP -1
    n:=ASCAN(aStruct,{|x|UPPER(x[1])==UPPER(aPol[i,1])})
    IF n==0
      lGo:=.T.
      ArIns(aStruct,if(nPosCrc>0,nPosCrc,FCOUNT()+1),aPol[i])
    ELSEIF UPPER(aStruct[n,2])!=UPPER(aPol[i,2]).OR.aStruct[n,3]!=aPol[i,3].OR.aStruct[n,4]!=aPol[i,4]
      lGo:=.T.
      aStruct[n]:=aPol[i]
    ENDIF
   NEXT

   FOR i:=1 TO Len(aDelArr)
    n:=ASCAN(aStruct,{|x|UPPER(x[1])==UPPER(aDelArr[i])})
    IF n>0
      lGo:=.T.
      ADel(aStruct,n)
      ASize(aStruct,Len(aStruct)-1)
    ENDIF
   NEXT


   IF lGo
      ScrTitul(MaxRow(),"      Идет коррекция полей базы         [ ]  ")

      DBCREATE((cTempFile := UPPER(TEMPFILE(_TMP_DIR, "DBF"))),aStruct)
      cTmpAlias := "TMP_BASE"

      NetUseExcA(cTmpAlias,cTempFile)

      nIndik := INDIK_NEW( MaxRow(), 56 )
      SELECT (cAlias)

      DBEVAL({|| INDIK_UPDATE(nIndik),;
              (cTmpAlias)->(dbAppend(),GatherS((cAlias)->(ScatterS())));
           })

      (cTmpAlias)->(DbCloseArea())
      (cAlias)->(DbCloseArea())
      FERASE(STRTRAN(cBase,".DBF",".FPT"))
      IF FILE(STRTRAN(cTempFile,".DBF",".FPT"))
         COPY FILE (STRTRAN(cTempFile,".DBF",".FPT")) TO (LOWER(STRTRAN(cBase,".DBF",".FPT")))
      ENDIF
      FERASE(STRTRAN(cTempFile,".DBF",".FPT"))

      FERASE(cBase)
      COPY FILE (cTempFile) TO (LOWER(cBase))
      FERASE(cTempFile)

      INDIK_END(nIndik)
   ELSE
      CLOSE
   ENDIF
ENDIF
SELECT (bakSelect)
RETURN NIL


*********
* ArIns()
* Улучшенная процедура вставки элемента в массив.
*
PROCEDURE ArIns(A,N,E)
/*
  Параметры :
A - массив (можно многомерный)
N - позиция, на которую происходит вставка (N>0)
    (может быть за границей массива,
     тогда добавляется необходимое количество пустых элементов)
   по умолчанию - добавляется к концу массива
E - вставляемый элемент (любого типа)

  Вставляет элемент в любой массив, в т.ч. многомерный.
  При этом длина массива увеличивается
*/
Local L,I

If N==nil
  AAdd(A, nil)
  N:=Len(A)
Else
  If N>Len(A)
    Do While N>Len(A)
      AAdd(A, nil)
    EndDo
  Else
    AAdd(A, nil)

    L:=Len(A)
    For I:=L To N+1 STEP -1
      A[I]:=A[I-1]
    Next I
  EndIf
EndIf
A[N]:=E
RETURN



FUNCTION WinReport(cReport,cFile,cFile1,lDesigner)
/**********
cFile - имя файла описания шапки с полями:VarName,VarC,VarN,VarD,VarL,FieldName
или массив {cVarName,xVar, cField/nElement} - наименование, значение, имя поля в cFile1 или в номер значения в строке-массиве
сFile1 - имя файла строк или массив значений
В более сложных случаях может в cFile1 могут быть перечислены несколько файлов
через запятую,например "File1,File2,File3",тогда в первом файле сField указывается
в виде "File.Pield", где File - не обязательно полное имя файла таблицы,
может быть часть, лишь бы бы входила бы как часть имени и отличалась от других
Вместо файлов могут передаваться алиасы открытых областей (тогда, если их
несколько, в cField указывается точное название алиаса и имя поля через точку).
*********************************/


LOCAL nArea:=SELECT()
LOCAL aVar:={},aVar1:={},nField,xVal
LOCAL lTable1:=VALTYPE(cFile1)="C".AND.NetUses(cFile1,aVar1)
LOCAL lArray1:=VALTYPE(cFile1)=="A",aLen:={}
LOCAL lTable:=VALTYPE(cFile)="C".AND.(SELECT(cFile)>0.OR.NetUse("RpTable",cFile,,,,.T.))
LOCAL cVarFile:=TEMPFILE(m->GlobalTmpPath,"xml"),nVarFile
LOCAL cHead:="",cVar:='<Row i_d="1" ',j:=1,i,cSpisok,nSpisok
LOCAL aVar1N

IF !(VALTYPE(cReport)=="C".AND.!EMPTY(cReport))
   SayError("Ошибка в указании 1-го параметра (имени шаблона) WinReport!")
   RETURN "WINREPORT"
ELSEIF EMPTY(cFile)
   SayError("Ошибка в указании 2-го параметра WinReport!")
   RETURN "WINREPORT"
ENDIF

altd()

busy(.T.,"Подготовка данных")

IF lArray1
   //находим макс.длины полей, если задан массив строк
   ASIZE(aLen,LEN(cFile1[1]))
   AFILL(aLen,0)
   FOR i:=1 TO LEN(cFile1)
   FOR j=1 TO LEN(cFile1[i])
   IF VALTYPE(cFile1[i,j])=="C"
      aLen[j]:=MAX(aLen[j],LEN(cFile1[i,j]))
   ENDIF
   NEXT
   NEXT
   aVar1:={{"","",{}}}
ENDIF



IF lTable
   IF SELECT(cFile)>0
      DbSelectArea(cFile)
   ELSE
      SELECT RpTable
   ENDIF
   cAlias:=ALIAS()
   DbGoTop()
   WHILE !EOF()
      IF !(DELETED().OR.EMPTY(FIELD->VarName))


         IF EMPTY(FIELD->FieldName)
            xVal:=GetMyVar()
            AADD(aVar,{MyName(FIELD->VarName),VALTYPE(xVal),LenVar(xVal),xVal})
         ELSEIF lTable1

            AddVar1(aVar1,cFile1,MyName((cAlias)->VarName),(cAlias)->FieldName)
         ENDIF
      ENDIF
      SKIP
   ENDDO
ELSEIF VALTYPE(cFile)=="A"
   FOR i:=1 TO LEN(cFile)
   IF LEN(cFile[i])<3.OR.EMPTY(cFile[i,3])
      xVal:=cFile[i,2]
      AADD(aVar,{MyName(cFile[i,1]),VALTYPE(xVal),LenVar(xVal),xVal})
   ELSEIF lTable1
      AddVar1(aVar1,cFile1,MyName(cFile[i,1]),cFile[i,3])
   ELSEIF lArray1.AND.VALTYPE(cFile[i,3])=="N".AND.(nField:=cFile[i,3])>0
      AADD(aVar1[1,3],{MyName(cFile[i,1]),VALTYPE(cFile1[1,nField]),aLen[nField],nField})
   ENDIF
   NEXT
ENDIF



IF ( nVarFile := FCREATE(cVarFile) ) == -1
   SayError( "Ошибка создания временного файла "+cVarFile)
ELSE
   FWRITE(nVarFile,'<?xml version="1.0" encoding="windows-1251"?>'+CRLF)
   FWRITE(nVarFile,"<DataBase>"+CRLF)

   FWRITE(nVarFile,"<SMakers>"+CRLF)

   FWRITE(nVarFile,'<SMaker name="bda.s_maker">'+CRLF)
   //Шапка
   FWRITE(nVarFile,'<Part PartName="'+DosToXML("Шапка")+'" PartType="1">'+CRLF)
   FOR i:=1 TO LEN(aVar)
   cHead+=FieldToXml(i,aVar[i,1],aVar[i,2],aVar[i,3])
   cVar+=Fi(i)+'="'+ DosToXML(GetVal(aVar[i,4]))+'" '
   NEXT
   FWRITE(nVarFile,"<FieldDefs>"+CRLF)
   FWRITE(nVarFile,cHead)
   FWRITE(nVarFile,"</FieldDefs>"+CRLF)
   FWRITE(nVarFile,"<Rows>"+CRLF)
   cVar+="/>"+CRLF
   FWRITE(nVarFile,cVar)
   FWRITE(nVarFile,"</Rows>"+CRLF)
   FWRITE(nVarFile,'</Part>'+CRLF)

   IF lTable1.OR.lArray1
      FOR nSpisok:=1 TO LEN(aVar1)
      //Список
      cHead:=""
      cSpisok:="Список"
      IF LEN(aVar1)>1
         cSpisok+="_"+aVar1[nSpisok,4]
      ENDIF
      FWRITE(nVarFile,'<Part PartName="'+DosToXML(cSpisok)+'" PartType="1">'+CRLF)
      aVar1N:=aVar1[nSpisok,3]

      FOR i:=1 TO LEN(aVar1N)
      cHead+=FieldToXml(aVar1N[i,4],aVar1N[i,1],aVar1N[i,2],aVar1N[i,3])
      NEXT
      FWRITE(nVarFile,"<FieldDefs>"+CRLF)
      FWRITE(nVarFile,cHead)
      FWRITE(nVarFile,"</FieldDefs>"+CRLF)
      FWRITE(nVarFile,"<Rows>"+CRLF)
      j:=1
      IF lTable1
         DbSelectArea(aVar1[nSpisok,2])
         dbGoTop()
         WHILE !EOF()
            cVar:='<Row i_d="' + LTRIM(STR(j++,10,0))+'" '
            FOR i:=1 TO LEN(aVar1N)
            IF (nField:=aVar1N[i,4])>0
               cVar+=FI(nField)+'="'+ DosToXML(GetVal(FIELDGET(nField)))+'" '
            ENDIF
            NEXT
            cVar+="/>"+CRLF
            FWRITE(nVarFile,cVar)
            SKIP
         ENDDO
      ELSE
         FOR j:=1 TO LEN(cFile1)
         cVar:='<Row i_d="' + LTRIM(STR(j,10,0))+'" '
         FOR i:=1 TO LEN(aVar1N)
            IF (nField:=aVar1N[i,4])>0
               cVar+=FI(nField)+'="'+ DosToXML(GetVal(cFile1[j,nField]))+'" '
            ENDIF
            NEXT
            cVar+="/>"+CRLF
            FWRITE(nVarFile,cVar)
         NEXT
      ENDIF
      FWRITE(nVarFile,"</Rows>"+CRLF)
      FWRITE(nVarFile,'</Part>'+CRLF)
      NEXT //nSpisok
   ENDIF

   FWRITE(nVarFile,"</SMaker>"+CRLF)
   FCLOSE(nVarFile)
   AppendDopFile(cVarFile)

ENDIF


busy(.F.)
IF lTable.AND.SELECT("RpTable")>0
   RpTable->(DbCloseArea())
ENDIF
IF lTable1
   NetCloses(aVar1)
ENDIF

FRCall("ShowReport",LoadPath()+cReport,cVarFile,IF(lDesigner!=NIL.AND.lDesigner,1,0),1)
WHILE .T.
   INKEY(.1)
   IF !FILE(cVarFile)
      Exit
   ENDIF
ENDDO
SELECT(nArea)

RETURN "WINREPORT"

STATIC FUNCTION GetMyVar()
IF FIELDNUM("VarN")>0.AND.!EMPTY(FIELD->VarN)
   RETURN FIELD->VarN
ELSEIF FIELDNUM("VarD")>0.AND.!EMPTY(FIELD->VarD)
   RETURN FIELD->VarD
ELSEIF FIELDNUM("VarC")>0.AND.!EMPTY(FIELD->VarC)
   RETURN TRIM(FIELD->VarC)
ELSEIF FIELDNUM("VarL")>0.AND.!EMPTY(FIELD->VarL)
   RETURN FIELD->VarL
ENDIF
RETURN NIL


STATIC FUNCTION MyName(cName)


cName := ALLTRIM(CharRem('().,!@#$%^&*+-:;|"?',ALLTRIM(cName)))
cName := CharRepl(" \/", cName,"_")

IF LEN(cName)==0
    cName:="_"
ENDIF
RETURN cName



STATIC PROCEDURE AddVar1(aVar1,cFile1,cVarName,cFieldName)
LOCAL aTable:=StrToArray(cFile1,",")
LOCAL j:=0,cTable,cField,n:=1,nField
IF VALTYPE(cFieldName)=="N"
   nField:=cFieldName
ELSE
   j:=RAT(".",cFieldName)
   cTable:=TRIM(IF(j>0,LEFT(cFieldName,j-1),aTable[1]))
   cField:=TRIM(SUBSTR(cFieldName,j+1))
   n:=ASCAN(aVar1,{|x|UPPER(TRIM(cTable))$UPPER(TRIM(x[1]))})
   nField:=(aVar1[n,2])->(FIELDNUM(cField))


ENDIF
IF nField>0

   AADD(aVar1[n,3],;
   {MyName(cVarName),(aVar1[n,2])->(FIELDTYPE(nField)),;
   IF((aVar1[n,2])->(FIELDTYPE(nField))="C",(aVar1[n,2])->(FIELDSIZE(nField)),0),nField})
   IF j>0
      aVar1[n,4]:=SUBSTR(cTable,RAT("\",cTable)+1)
   ENDIF
ENDIF
RETURN



STATIC FUNCTION StrToArray(cString,cDelim)
LOCAL aArray:={}, i
cDelim:=If(cDelim==Nil,";",cDelim)
While ( (i:=AT(cDelim,cString)) > 0 )
  AADD(aArray, LEFT(cString, i-1))
  cString:=LTRIM(SUBSTR(cString,i+1))
End
If !EMPTY(cString)
  AADD(aArray,cString)
EndIf
RETURN (aArray)


STATIC PROCEDURE AppendDopFile(cVarFile)
LOCAL nDopFile,i
STATIC sDopFile,sPath
IF !(!EMPTY(sDopFile).AND.FILE(sDopFile).AND.UPPER(LoadPath())==UPPER(sPath))
   sDopFile := TEMPFILE( _TMP_DIR, "XML" )
   sPath:=loadPath()
   IF ( nDopFile := FCREATE(sDopFile) ) == -1
      SayError( "Ошибка создания временного файла "+sDopFile)
   ENDIF

   FWRITE(nDopFile,"</SMakers>"+CRLF)


   FWRITE(nDopFile,"<Tables>"+CRLF)
   TabletoXml(nDopFile,"VALUTA.DBF",loadPath())
   TabletoXml(nDopFile,"NUMBER.PRO",m->cProPath)

   TabletoXml(nDopFile,"LABEL.PRO",m->cProPath,{||UPPER(ALLTRIM(TruePath(FIELD->LBL_PATH)))==UPPER(LOADPATH())})
   VarToXml(nDopFile,"GLOBAL",{;
		{"CURR_BEG",DTOS(m->CURR_BEG)},;
		{"FC_0007",GetVal(m->GlobalValuta)},;
		{"FC_0013",GetVal(m->Global_Set[5])};
		},.F.)

   VarToXml(nDopFile,"PATH",{;
   {"PATH_DBF",IF(!EMPTY(m->LBL_WPPATH),m->LBL_WPPATH,LoadPath())},;
   {"PATH_PRO",m->cProPath}},.F.)

   FWRITE(nDopFile,"</Tables>"+CRLF)
   FWRITE(nDopFile,"</DataBase>"+CRLF)
   FCLOSE(nDopFile)
ENDIF
FileAppend(sDopFile,cVarFile)
RETURN


STATIC FUNCTION NetUses(cFile1,aVar1)
LOCAL aTable:=StrToArray(cFile1,","),i,lRet:=.T.
LOCAL nArea:=SELECT()

FOR i:=1 TO LEN(aTable)
IF SELECT(aTable[i])>0
   DbSelectArea(aTable[i])
ELSEIF !NetUse("RpTable"+ALLTRIM(STR(i,3,0)),aTable[i],,,,.T.)
   lRet:=.F.
   EXIT
ENDIF
AADD(aVar1,{aTable[i],ALIAS(),{},SUBSTR(aTable[i],RAT("\",aTable[i])+1)})
NEXT
SELECT(nArea)
RETURN lRet


STATIC PROCEDURE NetCloses(aVar1)
LOCAL i
FOR i:=1 TO LEN(aVar1)
IF  SELECT(aVar1[i,1])=0.AND.SELECT(aVar1[i,2])>0 //только если тут открывалось
   (aVar1[i,2])->(DbCloseArea())
ENDIF
NEXT
RETURN



Static Function LenVar(xVar)
  LOCAL nLen:=0
  IF ValType(xVar)=="C"
     nLen:=MAX(LEN(xVar),1)
  ENDIF
Return(nLen)




STATIC FUNCTION GetVal(uVal)
LOCAL cType:=VALTYPE(uVal)
DO CASE
   CASE cType="C"
    IF EMPTY(uVal)
     uVal:= " "
    ELSE
       uVal := TRIM(uVal)
    ENDIF
   CASE cType="D"
   uVal:=DTOS(uVal)
   CASE cType="N"
   uVal:=ALLTRIM(STR(uVal))
   CASE cType="L"
   uVal:=IF(uVal,"T","F")
   OTHERWISE
   uVal:=XTOC(uVal)
ENDCASE
RETURN uVal


Static Function DosToXML(cText)
  cText :=DosToWindows(TRIM(cText))
  cText := AtRepl(CHR(0), cText," ")
  cText := AtRepl('&', cText,"&amp;")
  cText := AtRepl('"', cText,"&quot;")
  cText := AtRepl('<', cText,"&lt;")
  cText := AtRepl('>', cText,"&gt;")
  cText := AtRepl("'", cText,"&apos;")

Return(cText)


Static Function Fi(i)
RETURN "F"+ALLTRIM(STR(i,3,0))

Static function FieldToXml(i,cName,cType,nLen)
  LOCAL cXml:=""

  cXml+='<Field name="'+Fi(i)+'" name32="'+DosToXML(cName)+'" type="'+cType+'"'
  IF cType  $ "C"
   cXml+=' width="'+ LTRIM(STR(nLen,10,0))+ '"'
  ENDIF
  cXml+='/>'+CRLF
Return(cXml)

STATIC Function VarToXml(nVarFile,cTableName,aVarName,lPart)
LOCAL cc,i

  IF lPArt
    FWRITE(nVarFile,'<Part PartName="'+DosToXML(cTableName)+'" PartType="1">'+CRLF)
  ELSE
    FWRITE(nVarFile,'<Table name="'+DosToXML(cTableName)+'">'+CRLF)
  ENDIF
     FWRITE(nVarFile,"<FieldDefs>"+CRLF)

   cc:=""
   FOR i:=1 TO LEN(aVarName)
     cc+=FieldToXml(i,aVarName[i][1],ValType(aVarName[i][2]),LenVar(aVarName[i][2]))
   NEXT
   FWRITE(nVarFile,cc)
     FWRITE(nVarFile,"</FieldDefs>"+CRLF)

     FWRITE(nVarFile,"<Rows>"+CRLF)
     cc:='<Row  i_d="1" '
     FOR i:=1 TO LEN(aVarName)
       cc+=fi(i)+'="'+ DosToXML(GetVal(aVarName[i][2]))+'" '
     Next
      cc+="/>"+CRLF
      FWRITE(nVarFile,cc)
     FWRITE(nVarFile,"</Rows>"+CRLF)
     FWRITE(nVarFile,IIF(lPArt,"</Part>","</Table>")+CRLF)
Return


STATIC Procedure TabletoXml(nVarFile,cTableName,cPath,bFor)
  LOCAL i,cc,j:=1
IF NetUse("Test1",cPath+cTableName)
   IF ValType(bFor)=="B"
     dbsetFilter(bFor)
     dbGoTop()
   ENDIF
   FWRITE(nVarFile,'<Table name="'+cTableName+'">'+CRLF)
     FWRITE(nVarFile,"<FieldDefs>"+CRLF)

   cc:=""
   FOR i:=1 TO Test1->(FCOUNT())
     cc+=FieldToXml(i,FIELDNAME(i),FIELDTYPE(i),FIELDLEN(i))
   NEXT
   FWRITE(nVarFile,cc)
     FWRITE(nVarFile,"</FieldDefs>"+CRLF)

     FWRITE(nVarFile,"<Rows>"+CRLF)

   WHILE !EOF()
      cc:='<Row i_d="' + LTRIM(STR(j,10,0))+'" '
      j++
      FOR i:=1 TO FCOUNT()
         cc+=FI(i)+'="'+ DosToXML(GetVal(FIELDGET(i)))+'" '
      NEXT
      cc+="/>"+CRLF
      FWRITE(nVarFile,cc)
      SKIP
   ENDDO
   CLOSE
    FWRITE(nVarFile,"</Rows>"+CRLF)
    FWRITE(nVarFile,"</Table>"+CRLF)
ENDIF
Return



Static Function GetParamdefs()
LOCAL  aParam:={}
LOCAL n:=0,nOldArea:=SELECT()
SELECT 0
USE (LoadPath()+"taxi\utc.DBF") ALIAS taxi_utc NEW SHARED
SET INDEX TO (LoadPath()+"taxi\utc.CDX")
Do WHILE !EOF()
  n=n+1
  AADD( aParam, {CHRTRAN(ALLTRIM(taxi_utc->name),' -,/\.!()','_________'), taxi_utc->code})
  dbSkip()
ENDDO
IF select("taxi_utc")>0
   dbCloseArea( "taxi_utc")
ENDIF

SELECT (nOldArea)
Return(aParam)



//Предполагается база с записью Vid,Type,Code,Name (или ShortName)
//(Vid,Type или Code могут отсутствовать)
//Если cVid указан, то устанавливается фильтр Vid+Type==cVid+cType

FUNCTION GRefer(cBase,cVid,cType,cHead,cHead1,bMayBlock,bClose,cFindMacro,NoEdit)
//cBase имя базы или блок открытия и RELATION
//bIs-блок проверки на возможность корректировки ключа или удаления
//bClose-блок закрытия (если задан блок открытия)
LOCAL cScreen:=SAVESCREEN(),aSetKey:=SaveSetKey()
LOCAL cColHead,aBlockCols,nLenCode,nLenName,lName
LOCAL nTop:=4,nBottom:=20
LOCAL cCurProc,aHeads,aRef
LOCAL aPict:={'@K','@K'}
LOCAL aWhen:={{||WGRefer()}}
LOCAL aValid:={{||ToRight(1)}}
LOCAL nUniMode:=2
LOCAL bDelInit:={||GDel()}
LOCAL bScrInit,aSortSeek,apHeads,cName

bPost:=IF(cVid!=NIL,;
{||;
FIELDPUT(FIELDNUM('Vid'),pVid),;
FIELDPUT(FIELDNUM('Type'),pType);
},NIL)
MayBlock:=bMayBlock
PRIVATE pVid:=cVid
PRIVATE pType:=cType
IF cHead1!=NIL
   nTop+=2
ENDIF
cHead1:=IF(cHead1==NIL,'',cHead1)
IF VALTYPE(cBase)=='C'
   m_Open_Base({cBase})
ELSE
   EVAL(cBase)
ENDIF
lName:=FIELDNUM('Name')>0
cName:=IF(lName,'Name','ShortName')
nLenCode:=FIELDSIZE(FIELDNUM('Code'))
nLenName:=FIELDSIZE(FIELDNUM(IF(lName,'Name','ShortName')))
cColHead:=' '+IF(nLenCode>0,SPACE(nLenCode+3),'')+;
PADR(IF(nLenName<12,'Наимен','Наименование'),nLenName+1)
IF (cVid!=NIL)
   SetScope('Vid+Type',pVid+pType)
ELSE
   pVid:=pType:=''
ENDIF
aHeads:={{'Код (номер)..... ','Code'},{'Наименование.... ',cName}}
aSortSeek:={;
{'- по кодам         ','Код?:','Code','pVid+pType+UPPER(aIn[1])',;
'@K','ToRight(1)'},;
{'- по наименованиям ','Наименование?:','LEFT(Name,10)',;
'pVid+pType+UPPER(TRIM(aIn[1]))','@K'}}
IF (nLenCode==0)
   aBlockCols:={;
   {{||IF(lName,FIELD->Name,FIELD->ShortName)},1}}
   ADEL(aHeads,1);ASIZE(aHeads,1)
   ADEL(aSortSeek,1);ASIZE(aSortSeek,1)
   aPHeads:={cHead,{'Наименование',cName}}
   aWhen:=aValid:=NIL
ELSE
   cColHead:=STUFF(cColHead,2,3,'Код')
   aBlockCols:={;
   {{||FIELD->Code},1},;
   {{||IF(lName,FIELD->Name,FIELD->ShortName)},4+nLenCode}}
   IF (EMPTY(INDEXKEY(2)))
      ASIZE(aSortSeek,1)
   ENDIF
   aPHeads:={cHead,{'Код','Code'},{'Наименование',cName}}
ENDIF
IF NoEdit!=NIL
   SETKEY(K_F8,{||1})
   SETKEY(K_F4,{||1})
   SETKEY(K_RETURN,{||1})
ENDIF
GO TOP
InitScreen(cHead,cHead1,cColHead)
IF NoEdit!=NIL
   ScrTitul(24,"F6,Alt-F6:Фильтр F7,Alt-F7:Поиск F9:Печать")
ELSEIF EMPTY(INDEXKEY(2))
   ASIZE(aSortSeek,1)
   ScrTitul(24,CHR(17)+"┘:Правка F4:Добавить F6,Alt-F6:Фильтр F7,Alt-F7:Поиск F8:Удалить F9:Печать")
ENDIF
InitList(nTop,nBottom,cColHead,aBlockCols,cCurProc,aHeads,aRef,;
       aPict,aWhen,aValid,nUniMode,bDelInit,bScrInit,aSortSeek,aPHeads,;
       bPost,,,,,,,cFindMacro)
IF (bClose==NIL)
   m_Close_Base({cBase})
ELSE
   EVAL(bClose)
ENDIF
RESTSCREEN(,,,,cScreen)
RestSetKey(aSetKey)
RETURN (NIL)

FUNCTION WGRefer()
LOCAL lRet:=.T.
IF FCOUNT()>1
  QHelp('...',,1,pVid+pType,'Code',21,25,bPost)
ENDIF
IF (nApp==1.AND.MayBlock!=NIL)
   lRet:=EVAL(MayBlock)
ENDIF
RETURN (lRet)


STATIC FUNCTION GDel()
IF (MayBlock!=NIL.AND.!EVAL(MayBlock))
   SayError("Запись задействована в базе данных!")
   RETURN(.F.)
ENDIF
RETURN(.T.)

