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


#include "my.ch"
#include "s_public.ch"

***************************************************************
/*   Запись и чтение значений переменных    GLOB_VAR()       */
/*    aVars:                                                 */
/*          1) { { "Имя1", Значение1 },;                     */
/*               { "Имя2", Значение2 } ; } Масcив для записи */
/*                                                           */
/*          2) { "Имя1", ;                Массив для чтнения */
/*               "Имя2",  }                                  */
/*                                                           */
/*    lRezim (.F.):  .T. - Запись,                           */
/*                   .F. - Чтение                            */
/*                                                           */
/*    cFileDbf - Имя базы с путем от DBASE\                  */
/*               OC\Glob3, SCLAD\GLOB4  - пример             */
/*               Glob_Var - основная                         */
/*    Если базы нет - она будет создана.                     */
/*                                                           */
/*    Возвращает массив значений  переменных                 */
/*                                                           */
***************************************************************

//#TRANSLATE NTOC(<x>) => ALLTRIM(STR(<x>,10,0))

Function Glob_Vars( aVars, lRezim, cFileDbf, lAllPath, Block )
  LOCAL  aRez := {}, lBase
  LOCAL  nSel := SELECT()
  LOCAL  xVar, cVar, cVarType, nI,;
         cPath := IF( EMPTY(lAllPath), LoadPath(), '' )

  FIELD Name, TYPE, PARAM1 IN Glob_Var
  lRezim := IF( lRezim == NIL, .F., lRezim )
  cFileDbf := UPPER(IF( cFileDbf == NIL, "GLOB_VAR", cFileDbf ))

  lBase := !( SELECT("GLOB_VAR") > 0 )   // База уже открыта?
  IF(ValType(Block) != "B",Block := {|| NIL },NIL)

  IF ValType( aVars ) == "C"
    aVars := { aVars }
  ENDIF

  BEGIN SEQUENCE
    IF lRezim .AND. !_REC_YES
      BREAK
    ENDIF


    IF lBase
      IF !FILE( cPath+cFileDbf+".DBF" )    // Если база отсутствует
        IF empty(fileseek(cPath+"*.*", 16))
          BREAK
        ENDIF
        VarCreate( cFileDbf,, lAllPath )
      ELSEIF !FILE( cPath+cFileDbf+".CDX" )    // Если индекс присутствует
        VarCreate( cFileDbf, .T., lAllPath )
      ENDIF

      IF !NetUse( "GLOB_VAR", cPath+cFileDbf )
        Error_Use()
        BREAK
      ENDIF

    ELSE
      SELECT GLOB_VAR
    ENDIF

    OrdSetFocus( 0 )

    FOR nI := 1 TO LEN( aVars )
      IF ValType( aVars[nI] ) == "C"
        cVar := PADR(UPPER(ALLTRIM(aVars[nI])),10)
        xVar := NIL
      ELSE
        cVar    := PADR(UPPER(ALLTRIM(aVars[nI][1])),10)
        xVar    := aVars[nI][2]
      ENDIF

      IF lRezim     // ЗАПИСЬ ?
        IF xVar <> NIL
          cVarType := ValType( xVar )
          if cVarType == 'C'
             xVar := PADR(xVar, LEN(PARAM1) )
            else
             xVar     := PADR(XTOC( xVar ), LEN(PARAM1) )
          endif
          LOCATE FOR GLOB_VAR->NAME = cVar
          IF FOUND()
            IF RecLock()
              PARAM1 := xVar
              TYPE  := cVarType
              AADD( aRez, cVar )  // Что записаль
            ENDIF
            UNLOCK
          ELSE
            IF AddRec()
              NAME  := cVar
              PARAM1 := xVar
              TYPE  := cVarType
              AADD( aRez, cVar )  // Что записали
            ENDIF
            UNLOCK
          ENDIF
        ENDIF
      ELSE  // ЧТЕНИЕ
        IF( EMPTY(MemVarBlock(cVar)),NIL,Block := MemVarBlock(cVar))
        LOCATE FOR GLOB_VAR->NAME = cVar
        IF FOUND() //dbSEEK( cVar )
          IF     TYPE == "C" ;  xVar :=       RTRIM(PARAM1)
          ELSEIF TYPE == "N" ;  xVar := CTOF( RTRIM(PARAM1) )
          ELSEIF TYPE == "D" ;  xVar := STOD( RTRIM(PARAM1) )
          ELSEIF TYPE == "L" ;  xVar := IF( RTRIM(PARAM1)=="T", .T., .F. )
          ELSEIF TYPE == "P" ;  xVar :=       PARAM1
          ELSE               ;  xVar := NIL
          ENDIF
        ELSE
          // Запись текущего значения в перм.,если не найдена
          IF Block!=NIL
             xVar := EVAL(Block)
          ENDIF
        ENDIF
        AADD( aRez, xVar )
        IF Block!=NIL
           EVAL(Block,xVar)
        ENDIF
      ENDIF

    NEXT

  END SEQUENCE

  IF lBase .AND. SELECT( 'GLOB_VAR' ) > 0
    Glob_Var->( dbCloseArea() )
  ENDIF
  SELECT( nSel )
RETURN ( aRez )



#ifndef __HARBOUR__



********             СТАРЫЙ ВАРИАНТ   ************************
*   Счетчик ( ТОЛЬКО ЧИСЛА )                                 *
*   cVar: Имя переменной                                     *
*  ПРИМЕР:                                                   *
*         Glob_StepPlus({ "_NNOper", 100 })                  *
*                     - Первый вызов, формирование счетчика  *
*                       или корректировка текущего значения  *
*         Glob_StepPlus("_NNOper")                           *
*                     - Обычный вызов                        *
*                       Возращает текущее значение счетчика  *
*                       и пишет в базу следущее              *
*                       Если счетчика с таким именем нет -   *
*                       он будет создан и иницилизирован '1' *
*         Glob_StepPlus("_NNOper", "BANK\Bank_Var")          *
*                     - вызов с указанием пути доступа и     *
*                       именем базы                          *
*                       Если базы нет - она будет создана    *
*         Glob_StepPlus("_NNOper",, 100)                     *
*                     - Вызов для восстановления предыдущего *
*                       значения счетчика (100 - тек.сгенер. *
*                       значен) или записи нового (100 - это *
*                       новое + 1) в случае если это         *
*                       корректно т.е. если за время перед   *
*                       вызовом Glob_StepPlus, счетчик       *
*                       не превысил значения к которому мы   *
*                       хотим вернутся или записать иначе    *
*                       остается текущее (большее) значение  *
* ---------------------------------------------------------- *
* Примечание: может работать и с записью числа в виде строки *
*             (корректны только целые числа)                 *
**************************************************************
Function Glob_StepPlus( cVar, cFileDbf, xVar, lAllPath, lSverka, nCount )
  LOCAL  nSel := SELECT(), lBase, xReadVar := xVar, lChar,;
         cPath := IF( EMPTY(lAllPath), LoadPath(), '' )
  LOCAL cAlias

  cFileDbf := IF( cFileDbf==NIL, "GLOB_VAR", cFileDbf )
  cAlias := TOKEN(TOKEN(cFileDbf,":\"),".",1)
  nCount := if(nCount==NIL,1,nCount)
  //Bs_GetAlias(cFileDbf)
  lBase    := !( SELECT(cAlias) > 0 )   // База уже открыта?
  IF ValType( cVar ) == "A"
    xVar  := cVar[2]
    cVar  := PADR(UPPER(ALLTRIM(cVar[1])),10)
  ELSE
    cVar  := PADR(UPPER(ALLTRIM(cVar)),10)
  ENDIF

  xVar  := IF((lChar := (ValType(xVar) = "C")), CTON(xVar), xVar)

  BEGIN SEQUENCE

    IF lBase
      IF !FILE( cPath+cFileDbf+".DBF" )    // Если база отсутствует
        VarCreate( cFileDbf,, lAllPath )
      ENDIF
      IF FILE(cPath+cFileDbf+".CDX")
        FERASE(cPath+cFileDbf+".CDX")
      ENDIF
      IF !NetUse( cAlias, cPath+cFileDbf )
        Error_Use()
        BREAK
      ENDIF

    ELSE
      SELECT (cAlias)
    ENDIF
    OrdSetFocus( 0 )
    LOCATE FOR FIELD->NAME = cVar

    IF xVar <> NIL        // Передано НОВОЕ значение

      IF !FOUND() //!dbSEEK( cVar )
        IF !EMPTY( lSverka ) .AND. xVar <= CTOF( RTRIM(FIELD->PARAM1) )
          BREAK
        ENDIF
        IF AddRec()
          FIELD->NAME   := cVar
          FIELD->TYPE   := ValType( xVar )
        ENDIF
      ENDIF
      // проверка корректности при установке счетчика (только в случае указания xVar)
      IF RecLock() .and. xReadVar = NIL .or. ;
         ValType(xReadVar := CTOF( RTRIM(FIELD->PARAM1) )) != "N" .or. ;
         xReadVar <= xVar-1
         FIELD->PARAM1 := PADR(XTOC( xVar ), LEN(FIELD->PARAM1) )
      ENDIF
      UNLOCK

    ELSEIF FOUND() //dbSEEK( cVar )        // Считываем
      IF RecLock()
        xVar   := CTOF( RTRIM(FIELD->PARAM1) )
        FIELD->PARAM1 := PADR(XTOC( xVar+1 ), LEN(FIELD->PARAM1) )
        UNLOCK
      ENDIF
    ELSE                       // Нет переменной !!!
      IF AddRec()
        FIELD->NAME   := cVar
        FIELD->TYPE   := 'N'
        FIELD->PARAM1 := PADR(XTOC( nCount+1 ), LEN(FIELD->PARAM1) )
      ENDIF
      xVar := nCount
    ENDIF

  END SEQUENCE

  IF lBase                     // Как открыли так и закроем
    (cAlias)->( dbCloseArea() )
  ENDIF
  SELECT( nSel )
RETURN IF( lChar , NTOC(xVar),  xVar )

PROCEDURE VarCreate( cFileDbf, lIndex, lAllPath )
  LOCAL cFile := IF( EMPTY(lAllPath), LoadPath(), '')+cFileDbf
  LOCAL cStru := {;
                   { 'NAME',   'C', 10,  0 },;
                   { 'PARAM1', 'C', 200, 0 },;
                   { 'TYPE',   'C',  1,  0 } ;
                 }

  IF EMPTY(lIndex)
    SELECT(0)            // Создание БАЗЫ
    dbCREATE( cFile, cStru,NameRdd() )
    dbCloseArea()
  ENDIF
  USE ( cFile ) EXCLUSIVE NEW ALIAS Glob_Var
  dbCloseArea()

  IF cFileDbf == "GLOB_VAR" .AND. ;
    EMPTY(lIndex)                 // Если это основная база DBASE\Glob_Var.DBF
    Glob_Vars( {;      // Запись начальных данных
                { 'FC_0001', 0             }, ;
                { 'FC_0002', ""            }, ;
                { 'FC_0003', "3.0"         }, ;
                { 'FC_0004', .F.           }, ;
                { 'FC_0005', ISCOLOR()     }, ;
                { 'FC_0006', .T.           }, ;
                { 'FC_0007', "РУБ"         }  ;
               }, .T. )
  ENDIF
RETURN



#else


********************  Новый вариант на 17 разрядов   *********
*   Счетчик ( ТОЛЬКО ЧИСЛА )                                 *
*   cVar: Имя переменной                                     *
*  ПРИМЕР:                                                   *
*         Glob_StepPlus({ "_NNOper", 100 })                  *
*                     - Первый вызов, формирование счетчика  *
*                       или корректировка текущего значения  *
*         Glob_StepPlus("_NNOper")                           *
*                     - Обычный вызов                        *
*                       Возращает текущее значение счетчика  *
*                       и пишет в базу следущее              *
*                       Если счетчика с таким именем нет -   *
*                       он будет создан и иницилизирован '1' *
*         Glob_StepPlus("_NNOper", "BANK\Bank_Var")          *
*                     - вызов с указанием пути доступа и     *
*                       именем базы                          *
*                       Если базы нет - она будет создана    *
*         Glob_StepPlus("_NNOper",, 100)                     *
*                     - Вызов для восстановления предыдущего *
*                       значения счетчика (100 - тек.сгенер. *
*                       значен) или записи нового (100 - это *
*                       новое + 1) в случае если это         *
*                       корректно т.е. если за время перед   *
*                       вызовом Glob_StepPlus, счетчик       *
*                       не превысил значения к которому мы   *
*                       хотим вернутся или записать иначе    *
*                       остается текущее (большее) значение  *
* ---------------------------------------------------------- *
* Примечание: может работать и с записью числа в виде строки *
*             (корректны только целые числа)                 *
**************************************************************
Function Glob_StepPlus( cVar, cFileDbf, xVar, lAllPath, lSverka, nCount )
  LOCAL  nSel := SELECT(), lBase, xReadVar := xVar, lChar,;
         cPath := IF( EMPTY(lAllPath), LoadPath(), '' )
  LOCAL cAlias


  cFileDbf := IF( cFileDbf==NIL, "GLOB_VAR", cFileDbf )
  cAlias := TOKEN(TOKEN(cFileDbf,":\"),".",1)
  nCount := if(nCount==NIL,1,nCount)
  lBase    := !( SELECT(cAlias) > 0 )   // База уже открыта?
  IF ValType( cVar ) == "A"
    xVar  := cVar[2]
    cVar  := PADR(UPPER(ALLTRIM(cVar[1])),10)
  ELSE
    cVar  := PADR(UPPER(ALLTRIM(cVar)),10)
  ENDIF

  xVar  := IF((lChar := (ValType(xVar) = "C")), CTON(xVar), xVar)

  BEGIN SEQUENCE

    IF lBase
      IF !FILE( cPath+cFileDbf+".DBF" )    // Если база отсутствует
        VarCreate( cFileDbf,, lAllPath )
      ENDIF
      IF FILE(cPath+cFileDbf+".CDX")
        FERASE(cPath+cFileDbf+".CDX")
      ENDIF
      IF !NetUse( cAlias, cPath+cFileDbf )
        Error_Use()
        BREAK
      ENDIF

    ELSE
      SELECT (cAlias)
    ENDIF
    OrdSetFocus( 0 )
    LOCATE FOR FIELD->NAME = cVar

    IF xVar <> NIL        // Передано НОВОЕ значение

      xVar:=VAL(RIGHT(STR(xVar,17,0),10))


      IF !FOUND() //!dbSEEK( cVar )
        IF !EMPTY( lSverka ) .AND. xVar <= CTOF( RTRIM(FIELD->PARAM1) )
          BREAK
        ENDIF
        IF AddRec()
          FIELD->NAME   := cVar
          FIELD->TYPE   := ValType( xVar )
        ENDIF
      ENDIF
      // проверка корректности при установке счетчика (только в случае указания xVar)
      IF RecLock() .and. xReadVar = NIL .or. ;
         ValType(xReadVar := VAL(RIGHT(STR(CTOF(TRIM(FIELD->PARAM1)),17,0),10))) != "N" .OR.  xReadVar <= xVar-1
         FIELD->PARAM1 := PADR(XTOC( xVar ), LEN(FIELD->PARAM1) )
      ENDIF
      UNLOCK

    ELSEIF FOUND() //dbSEEK( cVar )        // Считываем
      IF RecLock()

        xVar   := VAL(RIGHT(STR(CTOF( RTRIM(FIELD->PARAM1)),17,0),10))

        FIELD->PARAM1 := PADR(XTOC( xVar+1 ), LEN(FIELD->PARAM1) )
        UNLOCK
      ENDIF
    ELSE                       // Нет переменной !!!
      IF AddRec()
        FIELD->NAME   := cVar
        FIELD->TYPE   := 'N'
        FIELD->PARAM1 := RIGHT(PADR(XTOC( nCount+1 ), LEN(FIELD->PARAM1) ),10)
      ENDIF
      xVar := nCount
    ENDIF

  END SEQUENCE

  IF lBase                     // Как открыли так и закроем
    (cAlias)->( dbCloseArea() )
  ENDIF
  SELECT( nSel )
  xVar:=VAL(Str(ROUND(HB_Random(1,9999),0),4,0)+STRTRAN(STR(xVar,10,0)," ","0"))

RETURN IF( lChar , NTOC(xVar),  xVar )

PROCEDURE VarCreate( cFileDbf, lIndex, lAllPath )
  LOCAL cFile := IF( EMPTY(lAllPath), LoadPath(), '')+cFileDbf
  LOCAL cStru := {;
                   { 'NAME',   'C', 10,  0 },;
                   { 'PARAM1', 'C', 200, 0 },;
                   { 'TYPE',   'C',  1,  0 } ;
                 }

  IF EMPTY(lIndex)
    SELECT(0)            // Создание БАЗЫ
    dbCREATE( cFile, cStru,NameRdd() )
    dbCloseArea()
  ENDIF
  USE ( cFile ) EXCLUSIVE NEW ALIAS Glob_Var
  dbCloseArea()

  IF cFileDbf == "GLOB_VAR" .AND. ;
    EMPTY(lIndex)                 // Если это основная база DBASE\Glob_Var.DBF
    Glob_Vars( {;      // Запись начальных данных
                { 'FC_0001', 0             }, ;
                { 'FC_0002', ""            }, ;
                { 'FC_0003', "3.0"         }, ;
                { 'FC_0004', .F.           }, ;
                { 'FC_0005', ISCOLOR()     }, ;
                { 'FC_0006', .T.           }, ;
                { 'FC_0007', "РУБ"         }  ;
               }, .T. )
  ENDIF
RETURN




#endif





