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


/************************************
 Function DBOpenBases(aBases, cMessage, lExc, lRO, NoProcess, NoClearState)
 Function DBCloseBases(aBases, cMessage, NoProcess)
 Function DBPush(cAlias, xOrder, cFilter, aScope, aRelations, LAdd, nRecNo)
 Function DBPop()
 Function DBSave()
 Function DBRest(aSet)
*************************************/
#include "s_public.ch"
#define Y_Nil(_x)         _x == NIL
#define N_Nil(_x)         _x != NIL

#define Y_Type(_x, _t)    ValType(_x) == _t
#define N_Type(_x, _t)    ValType(_x) != _t

#define _PUSH_ALIAS    1
#define _PUSH_TAG      2
#define _PUSH_FILTER   3
#define _PUSH_SCOPE    4
#define _PUSH_RELATION 5
#define _PUSH_NUM_AREA 6
#define _PUSH_RECNO    7
#define _PUSH_BAGNAME  8  // Вася
#define _PUSH_STACK    9 //8 Вася

#define _PUSH_SIZE     8// И это правильно.



Static DBStatus[0]


/********
* Автор.............Панкратов Г.Е.
* Документирован....13.02.2003
* Назначение........Обьединенный вариант DbPush() и DbPop()
*
*  Copyright (c) 2003 Фирма "Интеллект-сервис". Все права сохраняются.
*
*  Функция: DBPush([<cAlias>], [<xOrder>], [<cFilter>],;
*                  [<aScope>], [<aRelations>], [<LAdd>], [<nRecNo>], [<lNoStek>])
*
*  Назначение: Сохраняет все текущие физические "элементы состояния" рабочей
*              области, такие как: алиас, текущий тег, текущий фильтр, Scope,
*              реляции, номер записи, анализируя, были ли они установлены
*              каждый в отдельности и устанавливает новые если заданы
*              соответствующие параметры. Если какой-либо параметр не задан
*              то значение соответствующего "элемента состояния" остается
*              прежним. Если необходимо снять текущие фильтр, Scope или
*              реляции то вместо соответствующего параметра надо передать
*              любое пустое значение кроме NIL: ("", {}, 0, .F.).
*              Все параметры опциональны.
*
*  Параметры:
*
*      <cAlias> - новый алиас (символьная строка).
*
*      <xOrder> - номер или имя нового тэга (число или символьная строка).
*
*     <cFilter> - новое выражение фильтра (символьная строка).
*
*      <aScope> - массив из двух, трех или четырех элементов соответствующих
*                 параметрам функции SetScope(), структура:
*
*                 {<cScope>, <xScope>, [<xScope1>], [<aOrder>]} .
*
*  <aRelations> - новые реляции в виде массива подмассивов из двух элементов,
*                 подмассивов может быть несколько, структура:
*
*                 { {<xLinkArea>, <cLinkExpr>},... }
*
*                 где:
*                      <xLinkArea> - номер или алиас рабочей области для
*                                    реляции (число или символьная строка).
*                      <cLinkExpr> - выражение реляции (символьная строка);
*                 Возможен вариант когда этот параметр строка используемая
*                 для реляции.
*        <LAdd> - если задан то реляции добавляются к существующим.
*                 Этот параметр для совмещения со складским модулем
*                 может быть алиасом связной таблицы.
*      <nRecNo> - новый номер записи (число).
*     <lNoStek> - не сохраняется в стек DBStatus, а сбрасывается в массив.
*/



Function DBPush( cAlias, xOrder, cFilter, aScope, aRelations, LAdd, nRecNo, lNoStek, lSaveBag )

   Local IsNoAli     := Y_Nil( cAlias ),;
         IsNoOrd     := Y_Nil( xOrder ),;
         IsNoFil     := Y_Nil( cFilter ),;
         IsNoScp     := Y_Nil( aScope ),;
         IsNoRel     := Y_Nil( aRelations ).or. (vALtYPE(aRelations)=="A".AND.len(aRelations)==0) ,;
         IsNoRec     := Y_Nil( nRecNo ),;
         IsNoStk     := Y_Nil( lNoStek )

   Local aOldStat
   Local IsAnotherAlias
   Local xT
   Local nLen
   Local i := 1

   IF !IsNoScp.AND.LEN(aScope)>4.AND.VALTYPE(aScope[4])="L".AND.VALTYPE(aScope[5])="A"
      aScope[4]:=aScope[5] //titov - когда приходит из запомненного aScope
   ENDIF


   aOldStat :=  DBSave(lSaveBag)

   If EMPTY(lNoStek)

      IsAnotherAlias := !If( IsNoAli, IsNoAli, aOldStat[1] == Upper(cAlias) )
      // 9 .F. если незадан алиас или оно не совпадает с текущим
      AAdd( aOldStat, IsAnotherAlias)
      AAdd( DBStatus, aOldStat)
      // Если заданный алиас не совпадает с текущим то сохраняем текущий и заданный
      If( !IsAnotherAlias, NIL, ( DBSelectArea( cAlias ), DBPush()) )
      If( IsNoRel, NIL,;
          ( xT := { Empty(aRelations), Y_Type(aRelations, "A"), Empty(LAdd), Y_Type(aRelations, "C") .AND. Y_Type(LAdd, "C") },;
            If( !( xT[1] .Or. ( xT[2] .And. xT[3] ) .Or. xT[4]), NIL, DBClearRelation());
          );
        )
      If( IsNoFil, NIL, DBClearFilter())
      If( IsNoScp, NIL, SetScope())
      If( IsNoOrd, NIL, OrdSetFocus(xOrder))
      If( IsNoScp, NIL,;
          If( Empty(aScope), NIL,;
              If( !( Y_Type( aScope, "A") .And. ( nLen := Len( aScope ) ) > 1), NIL,;
                  SetScope( aScope[1],;
                            aScope[2],;
                            If( nLen < 3,;
                                NIL,;
                                aScope[3];
                              ),;
                            If( nLen < 4,;
                                NIL,;
                                aScope[4];
                              ),,IF(!IsNoOrd,.T.,NIL);
                          );
                );
            );
        )
      If( IsNoFil, NIL, If( Empty(cFilter), NIL, DBSetFilter( &("{||" + cFilter + "}"), cFilter)))
      If( IsNoRel, NIL,;
          If( xT[1] .Or. !xT[2],;
              If( !xT[1] .AND. xT[4],;
                  DBSetRelation( LAdd, &("{|| "+aRelations+"}"), aRelations ),;
                  NIL;
                ),;
              AEval( aRelations,;
                     {|x, i| DBSetRelation(x[1], &("{||" + x[2] + "}"), x[2])};
                   );
            );
        )
      If( PCount() == 0, NIL, If( IsNoRec, DBGoTop(), DBGoTo(nRecNo) ) )
   EndIf

Return If( IsNoStk, NIL, aOldStat )


/********
*  Функция: DBPop([<lGo>], [<aSave>])
*
*  Назначение: Востанавливает все текущие физические "элементы состояния" рабочей
*              области, такие как: алиас, текущий тег, текущий фильтр, Scope,
*              реляции, номер записи, анализируя, были ли они установлены
*              каждый в отдельности и устанавливает новые если заданы
*              соответствующие параметры.
*
*  Параметры:
*
*      <lNoGo>    - при наличии не восстанавливается позиция текущей записи.
*
*      <aSave>  - если передан массив то восстановление идет по нему.
*/

Function DBPop( lNoGo, aSave )

   Local FL, SC, RL
   Local LE      := Len( DBStatus )
   Local IsNoSave := Y_Nil( aSave )

   If( IsNoSave, aSave := DBStatus[ LE ], NIL )

   DBRest(aSave,  lNoGo )

   If IsNoSave
      ASize( DBStatus, LE - 1 )
      If( LE == 1 .Or. !DBStatus[LE - 1, _PUSH_STACK], NIL, DBPop() )
   EndIf

Return (NIL)

/********
*  Функция: DBOpenBases( <xBases>, [<cMessage>], [<lExc>], [<lRO>], [<NoProcess>], [<NoClearState>], [<lFile>])
*
*  Назначение: Открывает базы данных
*
*  Параметры:
*
*      <xBases> - список открываемых баз данных. Может быть массивом {<NameTable>,...<nNameTable>}
*                 или если алиас не совпадает { {<Alias>,<NameTable>},...{<nAlias>,<nNameTable>} } или
*                 символьной строкой. "NameTable".
*    <cMessage> - символьная строка сообщения ( по умолчанию со стандартным сообщением ).
*        <lExc> - открываются при .T. локально базы данных ( по умолчанию общий доступ ).
*         <lRO> - открываются только для чтения ( по умолчанию все ).
*   <NoProcess> - показывать или нет индикацию при открытии ( по умолчанию показывается ).
*<NoClearState> - не очищает установки на область если база открыта ( по умолчанию не зачищает ).
*       <lFile> - не выдает предупреждения при отсутствии базы и открывает .IDX  если есть
*/
Function DBOpenBases( xBases, cMessage, lExc, lRO, NoProcess, NoClearState, lFile)

   Local nProcess := 0
   Local lOK      := .T.
   LOCAL aBases   := If( Y_Type( xBases,"A"), xBases, {xBases} )
   Local aSave    := DBSave()
   Local nLen     := Len( aBases )

   IF Y_Type( aBases[nLen], "A") .AND. Len( aBases[nLen] ) > 3
      aSave := aBases[nLen]
      ASize( aBases, --nLen )
   ENDIF

   If( Y_Type(cMessage, "C"),, cMessage := "Открытие баз данных")

   NoProcess    := Len( aBases ) <= 10 .OR. N_Nil(NoProcess)
   NoClearState := N_Nil(NoClearState)

   AEval( aBases,;
         {|x, i|If( Y_Type(x, "A"),, aBases[i] := {x, x} ),;
                ASize( aBases[i], 3);
         };
        )
   If( NoProcess,, nProcess := Proces_Ini(nLen, 17,, cMessage))

   AEval( aBases,;
          {|x,i,cFile|;
                cFile := IF( ".DBF"  $ Upper(x[2]),;
                             StrTran( Upper(x[2]),".DBF",""),;
                             x[2];
                           ),;
                If( Select(x[1]) == 0 .AND.;
                    ( Y_Nil(lFile) .OR. N_Type(lFile,"L") .OR.;
                      !lFile .OR. FILE( cFile + ".DBF" );
                    ),;
                    If( ( lOK := lOK .And.;
                                 NetUse( x[1],;
                                         x[2],;
                                         IF( Y_Type( lFile, "L") .AND.;
                                             lFile .AND.;
                                             FILE( cFile + ".IDX"),;
                                             cFile + ".IDX",;
                                             NIL;
                                           ),;
                                         lExc,,;
                                         lRO;
                                       );
                        ),;
                        NIL,;
                        aBases[i] := NIL;
                      ),;
                    If( Select( x[1] ) != 0 .AND. Empty( x[3] ),;
                        (x[1])->(;
                             aBases[i, 3] := DBSave(),;
                             DBCommit(),;
                             If( NoClearState,,;
                                 (;
                                   DBClearRelation(),;
                                   DBClearFilter(),;
                                   SetScope(),;
                                   OrdSetFocus(1),;
                                   DBGoTop();
                                 );
                               );
                                 ),;
                        NIL;
                      );
                  ),;
                If( NoProcess,, Proces_Update(nProcess));
          })


   If( NoProcess,, Proces_End(nProcess))
   If( lOK .AND. Len( aBases ) = 1, DbSelectArea( aBases[ 1, 1 ] ), NIL )
   If( lOK, AAdd( aBases, aSave ), (Error_Use(), Break(NIL)))

Return (NIL)



/********
*  Функция: DBCloseBases( <xBases>, [<cMessage>], [<NoProcess>])
*
*  Назначение: Закрывает базы данных
*
*  Параметры:
*
*      <xBases> - список закрываемых баз данных. Работает совместно с DbOpenBases().
*    <cMessage> - символьная строка сообщения ( по умолчанию со стандартным сообщением ).
                  Может также быть массивом закрываемых дополнительно таблиц.
*   <NoProcess> - показывать или нет индикацию при закрытии ( по умолчанию показывается ).
*/

Function DBCloseBases( xBases, cMessage, NoProcess)

   LOCAL nWSel:=WSELECT()
   Local nProcess := 0
   Local aBases   := IF( Y_Type( xBases, "A" ), xBases, { xBases } )
   Local nLen     := Len( aBases )
   Local aSave
   WSELECT(0)
//   IF Len( aBases ) = 0
//      Return(Nil)
//   endif
   If( N_Type( aBases[nLen], "A" ) .OR. Len( aBases[nLen] ) <= 3,,;
       (;
        aSave := AClone(aBases[nLen]),;
        ASize( aBases, --nLen );
       );
     )
   // Для совместимости со складом
  AEVAL(aBases,{|x,n| IF(x != NIL,;
                         (IF(ValType(x) != "A",;
                             aBases[n] := {x,x},;
                             NIL),;
                          ASIZE(aBases[n],3)),;
                         NIL) })
   If( N_Type( cMessage, "A" ),, AEval( cMessage, {|x| (x)->( DbCloseArea() ), FErase(x) } ) )

   If(Y_Type(cMessage, "C"),, cMessage := "Закрытие баз данных")
   //NoProcess := N_Nil(NoProcess)
   NoProcess    := Len( aBases ) <= 10 .OR. N_Nil(NoProcess)

   If( NoProcess,, nProcess := Proces_Ini(nLen, 17,, cMessage))

   AEval( aBases,;
         {|x|If( Y_Nil(x),,;
                 If( Select(x[1]) == 0,,;
                     ( x[1] )->( If( Y_Nil(x[3]),;
                                     (DBCLEARFILTER(),;
                                     DBCLEARRELATION(),;
                                     DBCloseArea()),;
                                     DBRest(x[3]);
                                   );
                               );
                   );
               ),;
            If( NoProcess,, Proces_Update(nProcess ) );
         };
        )

   If( NoProcess,, Proces_End(nProcess))
   If( Y_Nil(aSave),, DBRest(aSave))
   WSELECT(nWSel)

Return (NIL)

// информация о связях
STATIC Function RelationInfo()
  LOCAL  aRelations := {}
  Local xT:=NIL, i := 1

  While .T.
      If Empty( Alias() ) .OR. Empty( xT := DBRelation(i) )
         Exit
      Else
         If DBRSelect( i ) != 0
            AAdd( aRelations, {DBRSelect(i),Alias(DBRSelect(i)),xT})
         /*
         Else
            SayError("Ошибка в SET RELATION !!!")
            altd()
         */
         EndIf
      EndIf
      i++
   EndDo

Return(aRelations)

/********
*  Функция: DBSave()
*
*  Назначение: Сохраняет окружение таблицы в массив.
               Возвращая массив.
*  Параметры: нет.
*/

Function DBSave(lSaveBag)

   Local aSet
   Local xT:=NIL
   Local cTableName,cIndexName // Вася
   LOCAL lBag:=VALTYPE(lSaveBag)=="L".AND.!EMPTY(lSaveBag)


   IF lBag
      cTableName := Bs_TableName()
      cIndexName := Bs_IndexName()
   ENDIF

   aSet := If( Empty( xT := Alias() ),;
               AFill( Array(_PUSH_SIZE), ""),;
               {;
                 xT,;              // 1 Текущий алиас
                 OrdSetFocus(),;   // 2 Текущий таг
                 DBFilter(),;      // 3 Текущий фильтер
                 GetScope(),;      // 4 Текущий индексный фильтр
                 RelationInfo(),;  // 5 Текущие выражения связи и  алиасы областей связанных
                 SELECT(),;        // 6 Текущий номер рабочей области
                 RecNo(),;          // 7 Текущий номер записи
                 IIF(lBag,;
                      IIF(UPPER(LEFT(cTableName,LEN(cTableName)-3)) != UPPER(LEFT(cIndexName,LEN(cIndexName)-3)),cIndexName,""),;
                                 "");  // 8 Имя индексного файла  - Вася
               };
             )

Return (aSet)

/********
*  Функция: DBRest(<aSet>)
*
*  Назначение: Восстанавливает окружение таблицы.
*  Параметры:
*     <aSet>  -  Массив окружения среды таблицы возвращенный DbSave()
* <lNoGo>    - при наличии не восстанавливается позиция текущей записи.
*/

Function DBRest(aSet,lNoGo, lNoBag)
  // lNoBag - не открывать баги  Victor
  LOCAL aSetK
  LOCAL lRefreshRelation:=.F.

   If Empty( aSet[_PUSH_ALIAS] ) .OR. Select( aSet[_PUSH_ALIAS] ) == 0
      DBSelectArea(0)
   Else

      DBSelectArea( aSet[_PUSH_ALIAS] )
      // попытаемся не обновлять связи
      lRefreshRelation:= GetUpdateIn(RelationInfo(),aSet[_PUSH_RELATION])

      IF lRefreshRelation
        DBClearRelation()
      endif

      DBClearFilter()
      IF EMPTY(lNoBag) .AND. !EMPTY(ALLTRIM(aSet[_PUSH_BAGNAME])).AND.FILE(ALLTRIM(aSet[_PUSH_BAGNAME]))
          OrdListAdd(aSet[_PUSH_BAGNAME],aSet[_PUSH_TAG])
      ENDIF
      OrdSetFocus( aSet[_PUSH_TAG] )
      IF !EMPTY(aSet[_PUSH_TAG]).AND.EMPTY(OrdSetFocus())   //victor
         OrdSetFocus(1)
      ENDIF

      SetScope( aSet[_PUSH_SCOPE] )
      If( Empty(aSet[_PUSH_FILTER]),,DBSetFilter(&("{||" + aSet[_PUSH_FILTER] + "}"), aSet[_PUSH_FILTER]))
        If lRefreshRelation .and. !Empty(aSet[_PUSH_RELATION])
           RefreshRelations(aSet[_PUSH_RELATION],.T.)
        endif
      IF EMPTY/*Y_Nil*/( lNoGo )
        DBGoTo( aSet[_PUSH_RECNO] )
      ENDIF
   EndIf
Return (NIL)

/*
    GetUpdateIn(a1,a2) возвращает .T. если массивы
                                        отличаются
*/



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

FUNCTION GetUpdateIn(aIn,aLastIn,nUpdate,nI)
//--------------------------------------------------------------------------//
// nUpdate номер первого найденного измененного элемента (по ссылке)
// nI с какого элемента начинать
LOCAL lUpdated:=.F., nFi
nUpdate := 0
IF( ValType(nI)<>'N',nI:=1,)

IF !(lUpdated := LEN(aIn) != LEN(aLastIn))
  AEval(aIn,;
        {;
           |x, i|;
           nFi := i,;
           If(ValType(x) == "A",;
            If(ValType(aLastIn[i]) == "A" .And. Len(x) == Len(aLastIn[i]),;
               IF( GetUpdateIn(x,aLastIn[i],,1),lUpdated:=.T.,),;
             lUpdated:=.T.),;
            If(ValType(x) == ValType(aLastIn[i]);
               .And.;
               x == aLastIn[i],,;
             lUpdated:=.T.)),;
           IF(nUpdate = 0 .AND. lUpdated,nUpdate := nFi,NIL);
        },nI)
ENDIF
RETURN lUpdated

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





******************
FUNCTION RefreshRelations(aRel,lNoClear)
******************
// Восстанавливает RELATION в том случае, когда реальная связь пропадает,
// а описание ее остается правильное.
IF ValType(aRel)<>"A"
  aRel:=RelationInfo()
ENDIF
IF ValType(lNoClear)<> "L"
  lNoClear:=.F.
ENDIF
IF !lNoClear
  DBClearRelation()
ENDIF
If !Empty(aRel)
   AEval( aRel, {|x, i| IF(SELECT(x[2])>0,DBSetRelation( x[2], &("{||" + x[3] + "}"), x[3]),)})
endif

RETURN .T.

//--------------------------------------------------------------------------//
                       PROCEDURE ReOpenDbf(lNoIndex,cAlias,lOpen)
//--------------------------------------------------------------------------//
// Переоткрывает текущий открытый DBF файл - используется после создания индекса
// lNoIndex - если .T., то восстановление без индексов
LOCAL aIndex := {}, lExclusive, cNameDbf, cAliasDbf, cSel := ALIAS()
Local aSave, i := 1,  nDescript,aRefreshRealion:={}

 cAliasDbf := UPPER(IF(ValType(cAlias) = "C",cAlias,ALIAS()))

 DBSelectArea(cAliasDbf)
/* необходимо уточнить необходимость в бэст4
 WorkSpaceEval( {|| IIF(ASCAN( DbRList(),{|x|x==ALIAS()+"_"+cAliasDbf})>0,;
  (AADD(aRefreshRealion,{ALIAS(),RelationInfo()}),DBClearRelation()) ,;
  ) } )
*/

 aSave := DBSave()

 aIndex := BsSaveIndex()
 lExclusive := !Bs_IsShared()
 cNameDbf := Bs_TableName()

 IF ValType(cAlias) = "C"
   (cAliasDbf)->(dbCloseArea())
   nDescript := FOPEN(cNameDbf,1)
   lOpen := nDescript <= 0
   FCLOSE(nDescript)
 ENDIF

 IF !EMPTY(lNoIndex)
    CLOSE INDEXES
 ENDIF

 NetUse(cAliasDbf,cNameDbf,IF(EMPTY(lNoIndex).AND.!EMPTY(aIndex),aIndex,{}),lExclusive,,,.F.)

 AEVAL(aRefreshRealion,{|x|(x[1])->(RefreshRelations(x[2],.T.))})

 DBRest(aSave,,lNoIndex)


 DBSelectArea(cSel)

RETURN


FUNCTION Get_DbStatus() //для передачи в xHarbour
RETURN dbStatus

PROCEDURE Set_DbStatus(a) //для передачи из xHarbour в аляску
dbStatus:=a
RETURN

