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


* Открытие базы данных в распределенном режиме
* NetUse(cAlias,cFile [,acIndexes]) --> lSuccess
* acIndexes - либо имя одного индексного файла, либо массив символьных имен

* Открытие базы данных в монопольном режиме
* NetUseExc(cAlias,cFile [,acIndexes]) --> lSuccess

* Добавление пустой записи и (при успехе) ее блокирование
* AddRec() --> lSuccess

* Блокирование записи
* RecLock() --> lSuccess

/*
РЕКОМЕНДАЦИИ ПО НАПИСАНИЮ СЕТЕВЫХ ПРОГРАММ

    1. Открывайте все необходимые базы данных  в распределенном режиме.

       Монопольный режим должен использоваться только для выполнения следую-
       щих команд:
          PACK
          INDEX ON
          REINDEX
          ZAP
       Доступ  к рабочим  областям всегда  выполняйте по  алиасам, а  не по
       буквенным или числовым  обозначениям. Функции открытии базы данных
       выбирают неиспользуемую рабочую область.

    2. При совместном использовании базы данных для записи информации необхо-
       дима блокировка записи или всего файла. Блокировка временно "захватыва-
       ет запись или файл для данного пользователя, другие пользователи при
       этом могут только читать соответствующие данные, но не править их.
       Блокировку всего файла необходимо производить только в крайних случаях,
       для команд, обрабатывающих группу записей:
          APPEND FROM
          DELETE (несколько записей)
          RECALL (несколько записей)
          REPLACE (несколько записей)
          UPDATE ON

    3. Блокировка записи, в том числе устанавливаемая автоматически после
       AddRec(), должна являться основным средством внесения изменений
       в базу данных. Ее необходимо применять в следующих случаях:
       - перед оператором REPLACE или FIELD:=... ;
       - перед использованием @...GET с именем поля;
       - перед одиночной командой DELETE.
       Для чтения данных блокировка не нужна.
       Вместо APPEND BLANK при работе в сетевой среде используйте функцию
       AddRec().
       При попытке блокировки или добавления пустой записи никогда не надей-
       тесь на положительный исход, обеспечьте информирование и выдачу реко-
       мендаций пользователю в каждом конкретном случае невозможности блоки-
       ровки.


    4. Любую блокировку используйте на минимально возможный период, после
       чего необходимо выполнить команду UNLOCK (для текущей рабочей области)
       или UNLOCK ALL (для всех областей). Во избежания длительной блокиров-
       ки записи при использовании GET с именем поля по возможности осуществ-
       ляйте (где это логически допустимо) ввод данных через переменные, а
       блокировку используйте только на время REPLACE.

    6. Все приведенные в данном файле функции пытаются осуществить соответ-
       ствующую операцию (открытие, блокировку) при неудачном исходе несколько
       раз в течение 1 сек и только тогда дают отрицательный результат.

     7. Особо упорная блокировка происходит при установке SetAllLock(.T.)
        При этой установке принимаются все возможные меры
        для удачного прохождения блокировки.
*/


#include "s_public.ch"



STATIC nOpenSec := 0, lGetLock := .F., dOpenData
STATIC aFilePath
STATIC lYesMessage := .T.

Static aAreas := {}
Static PrevArea


PROCEDURE ClearYesMessage()
  lYesMessage := .T.
RETURN
/*
 aFilePath[ 1 ][ 1 ]       - Глобальный путь к базам ( сверяется с LoadPath() )

 aFilePath[ 1 ][ 2 ][ 1 ]  - Путь поиска баз
              ...
 aFilePath[ 1 ][ 2 ][ i ]

 aFilePath[ 2 ][ 1 ][ 1 ]  - Имя Базы
 aFilePath[ 2 ][ 1 ][ 2 ]  - Путь к базе
              ...
 aFilePath[ 2 ][ i ][ 1 ]
 aFilePath[ 2 ][ i ][ 2 ]
*/

********************************************************
*                Для совместимости                     *
********************************************************
FUNCTION NetUseExc( cAlias, cFile, cIndexes, cRdd, lReadyOnly, lNew, lNoIndex)
RETURN NetUse( cAlias, cFile, cIndexes, .T., cRdd,lReadyOnly, lNew, lNoIndex) 


//открытие без индекса
FUNCTION NetUseExcA(cAlias,cFile) 
RETURN NetUse( cAlias,cFile,,.T.,,,,.T.) 





*********************************************************
* Возвращает имя активного в данный момент драйвера     *
* NameRdd() --> 'DBFCDXAX' - Сервер баз данных активен  *
*           or  'DBFCDX'   - CDX драйвер                *                              *
*           or  'DBFNTX'   - NTX драйвер(только UPGRADE)*
*********************************************************
FUNCTION NameRdd()
RETURN( RDDSETDEFAULT() )

****************************************************************
* Открытие базы данных:                                        *
* в распределенном режиме  lExc := NIL or lExc := .F.          *
*          или                                                 *
* в монопольном  режиме    lExc := .T.                         *
* NetUse( cAlias,cFile,[cIndexes],[lExc],[cRdd] ) --> lSuccess *
****************************************************************
FUNCTION NetUse( cAlias,cFile,cIndexes, lExc, cRdd, lReadyOnly, lNew, lNoIndex )
LOCAL i, cDbfFile, cCdxFile,cDisk,;
        lForever:=.F., nSeconds:=10, nCo, cParol := GetId()
Local uPath,uLoad,nArea:=SELECT()
  cFile := ALLTRIM( cFile )
  i     := ATNUM( '.', cFile )
  IF ValType( cRdd ) <> 'C' ;   cRdd := NameRdd()           ; ENDIF
  IF VALTYPE( lNew ) <> 'L' ;   lNew  := .T.                ; ENDIF
  IF SELECT( cAlias ) > 0 .AND. lNew  ;   (cAlias)->( dbCLOSEAREA() ) ; ENDIF
  IF VALTYPE( lExc ) <> 'L' ;   lExc  := .F.                ; ENDIF
  IF( ValType(lReadyOnly) <> 'L', ;
      lReadyOnly := .F. ,;
    )

  IF UPPER(cRdd) == 'SIXCDX'
     cRdd:='DBFCDX'
  ENDIF

/***************
  if IsAds()
     if !Empty( uPath := Upper(ExtractPath( cFile )) )
        uLoad := Upper(LoadPath())
        if !( SUBSTR(uLoad,3) $ uPath )
           cRdd := 'DBFCDX'
        endif
        if "PRO\" $ uPath
           cRdd := 'DBFCDX'
        endif
     endif
  endif

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


  IF( i == 0.OR. i < LEN(cFile) - 3, i:= LEN(cFile), i-- )
  IF UPPER(RIGHT( cFile, 3 )) == 'PRO'
    cDbfFile := cFile
  ELSE
    cDbfFile := LEFT(cFile,i)+'.DBF'
    cFile := LEFT(cFile,i)
  ENDIF
/*
  IF !_REC_YES .AND. !Bs_IsTmp( cFile )
    // Глобальное запрещение записи
    lReadyOnly := .T.
  ENDIF
*/
  cCdxFile := LEFT(cFile,i)+'.CDX'

  IF( !FILE(cDbfFile), (nSeconds:= 0,SayError('Нет файла: '+cDbfFile)), ) // Нет базы


  DO WHILE (!lForever .AND. nSeconds > 0)
    WHILE  SECONDS() - nOpenSec < MemVar->WAIT_OPEN .AND. dOpenData = DATE(); ENDDO
    IF lNew

      IF lExc
        USE (cFile) ALIAS (cAlias) NEW VIA (cRdd) EXCLUSIVE
      ELSE
        USE (cFile) ALIAS (cAlias) NEW VIA (cRdd) SHARED
      ENDIF
    ELSE

      IF lExc
          USE (cFile) ALIAS (cAlias) VIA (cRdd) EXCLUSIVE
      ELSE
          USE (cFile) ALIAS (cAlias) VIA (cRdd) SHARED
      ENDIF
   ENDIF
    dOpenData := DATE()
    nOpenSec := SECONDS()

    IF !NETERR()               // USE успешно выполнена

     IF FILE(cCdxFile) .AND. EMPTY(cIndexes) .AND. EMPTY(lNoIndex)     // так как xH хватает CDX с таким же именем и падает
        TRY
           OrdListAdd( cCdxFile )
        CATCH
           SET INDEX TO
        END
      ENDIF
      IF (VALTYPE(cIndexes) == 'C')
         OrdListAdd(cIndexes )
      ELSEIF (VALTYPE(cIndexes) == 'A')
        FOR nCo:=1 TO LEN(cIndexes)
          IF (LEN(TRIM(cIndexes[nCo])) > 0)
            SET INDEX TO (cIndexes[nCo]) ADDITIVE
          ENDIF
        NEXT
      ENDIF
      lForever := .T.
      EXIT
    ENDIF
    // Ожидание приблизительно 0.1 секунда
//    INKEY(0.1)
    nSeconds--
  ENDDO


  IF !lForever
     IF nArea>0
        SELECT(nArea)
     ENDIF
  ENDIF
RETURN(lForever)


*************************
* Добавление  записи    *
* AddRec() --> lSuccess *
*************************
FUNCTION AddRec(lYesLock)
  FIELD USER_INFO
PLOCAL nWaitSeconds := 30, lRet := .F.

  lYesLock := lYesLock == NIL


  IF !_REC_YES .AND. !Bs_IsTmp().and.lYesLock
    nWaitSeconds := 0
     IF lYesMessage
       lYesMessage := .F.
       SayAndWait( { 'Добавление запрещено администратором!' } )
     ENDIF
  ELSE
    DO WHILE ( nWaitSeconds-- > 0 ) .OR. (lGetLock .AND. GetAllLock(.T.,@lRet))
      APPEND BLANK
      IF ( lRet := !NETERR() )
          IF FieldPos('USER_LOCK') > 0
             Field->USER_LOCK := AllTrim(IDENT_USER)+' '+DTOS(DATE())+' '+TIME()
             dbCommit()
          end

        IF FIELDPOS('USER_INFO') > 0
          USER_INFO := PADR(Global_set[2],6)+DTOS(DATE())+TIME()
        ENDIF
        // Lexx
        IF  FIELDPOS("CRYPT_CODE") != 0 .AND. !EMPTY(Global_Set[2])
            FIELD->CRYPT_CODE := CHR(VAL(SUBSTR(DTOC(DATE()),1,2)))+CHR(VAL(SUBSTR(DTOC(DATE()),4,2)))+CHR(VAL(SUBSTR(DTOC(DATE()),7,2)))+CHR(VAL(SUBSTR(TIME(),1,2)))+CHR(VAL(SUBSTR(TIME(),4,2)))+Global_Set[2]
            FIELD->CRYPT_CODE := CRYPT(FIELD->CRYPT_CODE,"Crypt_A3")
        ENDIF
        EXIT           // Запись добавлена
      ENDIF
      INKEY(0.1)         // ожидание 0.l секунды
    ENDDO
  ENDIF
#ifdef NO_ERROR
  RETURN (lRet .AND. AddRecInfoCRC())           // заблокирована ?
#else
  RETURN (lRet)           // заблокирована ?
#endif


**************************
* Блокирование записи    *
* RecLock() --> lSuccess *
**************************
// Если в базе определено поле USER_Lock C 40, в нем всегда хранится TERMINAL
// последнего клиента, сделавшего успешную блокировку
FUNCTION RecLock(lNoAvtor,lYesLock)
  FIELD USER_INFO
  PLOCAL nSeconds:= 30,lRet:=.F., cUserInfo
  lNoAvtor:=!EMPTY(lNoAvtor)
  lYesLock := lYesLock == NIL

  IF !_REC_YES .AND. !Bs_IsTmp( ).and.lYesLock
     nSeconds := 0
    IF lYesMessage
      lYesMessage := .F.
      SayAndWait( { 'Редактирование запрещено администратором!' } )
    ENDIF
  ELSE
    DO WHILE ( nSeconds-- > 0 ) .OR. (lGetLock .AND. GetAllLock(.F.,@lRet))

      IF lRet:=Bs_RLock() 

          IF FieldPos('USER_LOCK') > 0
             Field->USER_LOCK := AllTrim(IDENT_USER)+' '+DTOS(DATE())+' '+TIME()
             dbCommit()
          end

          IF FIELDPOS('USER_INFO') > 0
            cUserInfo := TRIM(USER_INFO)
            IF SUBSTR(cUserInfo,-22,6) == PADR(Global_set[2],6) ;
               .AND.                                            ;
               SUBSTR(cUserInfo,-16,8) == DTOS(DATE())          ;
               .AND.                                            ;
               TIMETOSEC(TIME()) - TIMETOSEC(SUBSTR(cUserInfo,-8,8)) < 300
              // Дадим клиенту 5 минут на раздумье
              USER_INFO := LEFT(cUserInfo,LEN(cUserInfo)-8)+TIME()
            ELSE
              USER_INFO := LEFT(USER_INFO,22)+;
                         SUBSTR(USER_INFO,23,22)+;
                         PADR(Global_set[2],6)+DTOS(DATE())+TIME()
            ENDIF

          ENDIF
          // Lexx
          IF  FIELDPOS("CRYPT_CODE") != 0 .AND. !EMPTY(Global_Set[2]) .AND. LASTKEY()<>-7 .AND. !lNoAvtor
              FIELD->CRYPT_CODE := CHR(VAL(SUBSTR(DTOC(DATE()),1,2)))+CHR(VAL(SUBSTR(DTOC(DATE()),4,2)))+CHR(VAL(SUBSTR(DTOC(DATE()),7,2)))+CHR(VAL(SUBSTR(TIME(),1,2)))+CHR(VAL(SUBSTR(TIME(),4,2)))+Global_Set[2]
              FIELD->CRYPT_CODE := CRYPT(FIELD->CRYPT_CODE,"Crypt_A3")
          ENDIF
          EXIT     // Заблокирована
      ENDIF
      INKEY(0.1)           // Ожидание 1/2 секунды
    ENDDO
  ENDIF
#ifdef NO_ERROR
  RETURN (lRet .AND. RecInfoCRC())           // заблокирована ?
#else
  RETURN (lRet)           // заблокирована ?
#endif

**************************
* Блокирование базы      *
* FilLock() --> lSuccess *
**************************
FUNCTION FilLock
   PLOCAL nSeconds:= 30, lRez := .F.
   IF !_REC_YES .AND. !Bs_IsTmp()
     nSeconds := 0
   ENDIF
   DO WHILE (nSeconds-- > 0)
     IF ( lRez := FLOCK() )
       EXIT     // Заблокирована
     ENDIF
     INKEY(0.1)         // Ожидание 1/2 секунды
   ENDDO
RETURN (lRez)         //  заблокирована ?

STATIC PROCEDURE LoadFilePath()
  PLOCAL cMyPath := '', aDir,i
  IF EMPTY( aFilePath ) .OR. aFilePath[1][1] <> LoadPath()
    cMyPath := SET( _SET_PATH ) // Загрузим пути
    IF !EMPTY( cMyPath )
      aFilePath := { { LoadPath(), LineToArray(cMyPath,';') },;
                       {} }
      FOR i := 1 TO LEN( aFilePath[1][2] )
        aDir := DIRECTORY( aFilePath[1][2][ i ]+ '*.DBF' )
        AEVAL( aDir, {|x| AADD( aFilePath[2], { LEFT(x[1],ATNUM('.',x[1])-1), i } ) } )
      NEXT
    ENDIF
  ENDIF
RETURN

STATIC FUNCTION SeekFilePath( cFile )
  PLOCAL i, lRez := .F.
  cFile := UPPER(cFile)
  IF !EMPTY(aFilePath) .AND. ;
     ( i:= ASCAN( aFilePath[2], {|x| x[1] == cFile } ) ) <> 0
    cFile := aFilePath[1][2][ aFilePath[2][i][2] ] + aFilePath[2][i][1]
    lRez := .T.
  ENDIF
RETURN( lRez )
//--------------------------------------------------------------------------//
                           FUNCTION SetAllLock(lSet)
//--------------------------------------------------------------------------//
// Выставляет статус при котором блокировки записи повторяются в течении 3 мин
// (при отказе) с выводом информации и полным временным разблокированием всех
// занятых записей (для исключения тупиков)
PLOCAL lBakSet := lGetLock
IF lSet != NIL
  lGetLock := lSet
ENDIF
RETURN lBakSet
//--------------------------------------------------------------------------//
                     STATIC FUNCTION GetAllLock(lAdd,lLock)
//--------------------------------------------------------------------------//
// Дополнительная попытка избежать отказа блокировки
PLOCAL aAllLock := {}
PLOCAL nSelect, aRLock, cAlias, nOldRec, nRelation, cRel
PLOCAL bakGetLock := SetAllLock(.F.), nSeconds := SECONDS(), nCursor := SetCursor(0)
PLOCAL cScr, nWin := WSELECT()

lLock := .F.
// Сохраняем весь список блокировок и сбросим RELATION, где есть блокировки,
// что бы не мешались при восстановлении номеров записей
FOR nSelect := 1 TO 255
  IF !EMPTY(cAlias := ALIAS(nSelect)) .AND. !EMPTY((cAlias)->(aRLock := dbRLockList()))
    AADD(aAllLock,{cAlias,aRLock,{}})
    nRelation := 1
    WHILE  !EMPTY(cRel := (cAlias)->(DBRelation(nRelation)))
      AADD(ATAIL(aAllLock)[3],{ALIAS((cAlias)->(DBRSelect(nRelation++))),cRel})
    END
    (cAlias)->(dbClearRel())
  ENDIF
NEXT
// Все разблокируем
dbUnLockAll()

WSELECT(0)
cScr := SaveScreen(2,2,7,47)
DispEnd();DispEnd();DispEnd()
DispBox(2,2,7,47,2,COL_REFER)
WHILE .T.
  WHILE !(lLock := IF(lAdd,(dbAppend(),!NETERR()),Bs_RLock())) .AND. SECONDS()-nSeconds < 240  // Ждем 3 минуты
    DispOutAt(3,3,PADR(" Попытка блокировки :"+ALLTRIM(STR(SECONDS()-nSeconds,5,0))+" сек.",44),COL_REFER)
    DispOutAt(4,3,PADR(" Файл : "+ALLTRIM(Bs_TableName()),44),COL_REFER)
    DispOutAt(5,3,PADR(" Запись : "+AllTrim(Str(RecNO(),10)),44),COL_REFER)
         // IDENT_USER
    IF FIELDPOS('USER_LOCK') > 0
       DispOutAt(6,3,PADR(Field->USER_LOCK,44),COL_REFER)
     else
       DispOutAt(6,3,Space(44),COL_REFER)
    ENDIF
//                      234567890123456789012345678901234567
    Bs_UnLock()    // разблокировка для преодоления некоторых глюков
  END
  IF lLock .OR. !YesOrNo({" Программа не может использовать данные","файла "+ALLTRIM(Bs_TableName())," занятые на другой рабочей станции. "," Повторить попытку (рекомендуется повторить) ?"})
    EXIT
  ELSE
    nSeconds := SECONDS()
  ENDIF
END

RestScreen(2,2,7,47,cScr)
WSELECT(nWin)

// Восстановим весь список блокировок (если получится)
AEVAL(aAllLock,{|aAliasRLock| (aAliasRLock[1])->(AEVAL(aAliasRLock[2],{|nRec| nOldRec := RECNO(),dbGoTo(nRec),RecLock(),dbGoTo(nOldRec) })) })
// Восстановим все RELATION (если получиться)
AEVAL(aAllLock,{|aAliasRLock| (aAliasRLock[1])->(AEVAL(aAliasRLock[3],{|aRel| IF(TYPE(aRel[2]) != "U",dbSetRelation(aRel[1],&("{||"+aRel[2]+"}")),NIL) })) })
SetAllLock(bakGetLock)
SetCursor(nCursor)


RETURN .F.



//--------------------------------------------------------------------------//
                     FUNCTION BsSaveIndex()
//--------------------------------------------------------------------------//
// Возвращает массив имен бэгов
LOCAL i := 0, aIndex := {}
WHILE !EMPTY(ORDNAME(++i))
  IF ASCAN(aIndex,Bs_IndexName(i)) = 0
    AADD(aIndex,Bs_IndexName(i))
  ENDIF
END
RETURN aIndex
//--------------------------------------------------------------------------//
                     FUNCTION BsClearIndex()
//--------------------------------------------------------------------------//
// Закрывает бэги
RETURN ReOpenDbf(.T.)
//--------------------------------------------------------------------------//
                     FUNCTION BsRestIndex(aIndex)
//--------------------------------------------------------------------------//
// Открывает бэги по массиву
LOCAL i
FOR i := 1 TO LEN(aIndex)
  SET INDEX TO (aIndex[i]) ADDITIVE
NEXT
RETURN aIndex

//--------------------------------------------------------------------------//
               FUNCTION IsBagName(cBagName)
//--------------------------------------------------------------------------//
// Проверяет наличие cBagName в списке Bag'ов текущей базы
LOCAL nOrder := 0
WHILE !EMPTY(ORDNAME(++nOrder))
 IF ORDBAGNAME(nOrder) == cBagName
    RETURN .T.
 ENDIF
ENDDO
RETURN .F.
//--------------------------------------------------------------------------//
                     FUNCTION Bs_GetAlias(cFile)
//--------------------------------------------------------------------------//
// Возвращает алиас базы по имени
LOCAL i := 0
LOCAL cAlias
IF !"." $ cFile
  cFile += ".DBF"
ENDIF
cAlias := TOKEN(TOKEN(cFile,":\"),".",1)
FOR i := 1 TO 255
 IF !EMPTY(ALIAS(i)) .AND. (ALIAS(i))->(Bs_TableName()) == UPPER(cFile)
   cAlias :=  ALIAS(i)
   EXIT
 END
NEXT
RETURN cAlias
//--------------------------------------------------------------------------//
                       FUNCTION IsOpenDbf(cAlias)
//--------------------------------------------------------------------------//
// Возвращает признак открытия базы на других рабочих станциях
// по алиасу (cAlias)
LOCAL lOpen := .F.
ReOpenDbf(NIL,cAlias,@lOpen)
RETURN lOpen

//---------------------------------------------------------------------------
FUNCTION Bs_RecLock()
//---------------------------------------------------------------------------
//Блокируем запись (если она уже не была заблокирована).
//Если вернет (.T.) обязательно вызвать Bs_DbUnLock() !
LOCAL lRet, lLock
lLock:= (ASCAN(dbRLockList(),{|nRec| nRec = RECNO() }) != 0)
lRet:= lLock.OR.RecLock()
IF(lRet, PushData({lLock, ALIAS()}), NIL)
RETURN lRet

//---------------------------------------------------------------------------
FUNCTION Bs_DbUnLock()
//---------------------------------------------------------------------------
//Разблокируем запись (если если мы ее блокировали).
//И вытягиваем значения из стека (была ли она заблокирована нами).
LOCAL aVarPop:= PopData("View")
LOCAL lLock:= IF(ValType(aVarPop)=="A".AND.LEN(aVarPop)==2.AND.;
                 ValType(aVarPop[1])=="L".AND.ValType(aVarPop[2])=="C".AND.;
                 aVarPop[2]==ALIAS(), PopData()[1], .F.)
IF(!lLock, dbUnlock(), NIL)
RETURN .T.
//--------------------------------------------------------------------------//
                    PROCEDURE SetInfoCRC(lAll)
//--------------------------------------------------------------------------//
// Выставляет признак корректности записи
// lAll - если .T., то выставляется по всем заблокированным записям
//        в текущей области
LOCAL nRec
IF !EMPTY(lAll)
  nRec := RECNO()
  AEVAL(dbRLockList(),{|nRec| dbGoTo(nRec),SetInfoCRC() })
  dbGoTo(nRec)
ENDIF
IF FieldPos("CRC") != 0 .AND. FIELD->CRC = NIL_CRC(RECNO_CRC,PATH_CRC) .AND. Bs_RLock()
  FIELD->CRC := GetInfoCRC()
  IF  TYPE("lNoSaveUC")<>"L"
      FIELD->ID_ST := _USER_STATION
      FIELD->USER_CODE  := _USER_CODE
  ENDIF
ENDIF
RETURN
//--------------------------------------------------------------------------//
                    FUNCTION RecInfoCRC()
//--------------------------------------------------------------------------//
// Выставляет признак корректности записи
// в RecLock
IF FieldPos("CRC") != 0 .AND.;
   (GetInfoCRC() = FIELD->CRC .OR. NIL_CRC(RECNO_CRC,PATH_CRC) = FIELD->CRC)
  FIELD->CRC := NIL_CRC(RECNO_CRC,PATH_CRC)
  IF  TYPE("lNoSaveUC")<>"L"
      FIELD->ID_ST := _USER_STATION
      FIELD->USER_CODE  := _USER_CODE
  ENDIF
ENDIF

RETURN .T.
// DIM88
//--------------------------------------------------------------------------//
                    FUNCTION AddRecInfoCRC()
//--------------------------------------------------------------------------//
// Выставляет признак корректности записи
// в AddRec
IF FieldPos("CRC") != 0
  FIELD->CRC := NIL_CRC(RECNO_CRC,PATH_CRC)
  IF  TYPE("lNoSaveUC")<>"L"
      FIELD->ID_ST := _USER_STATION
      FIELD->USER_CODE  := _USER_CODE
  ENDIF
ENDIF
RETURN .T.
//--------------------------------------------------------------------------//
                     FUNCTION GetInfoCRC(cRecNo,cPath)
//--------------------------------------------------------------------------//
// Возвращает контрольный код
LOCAL cCRC := PRED_CRC(IF(cRecNo = NIL,RECNO_CRC,cRecNo),IF(cPath = NIL,PATH_CRC,cPath))
cCRC += IF(Delete(),"D","ND")
AEVAL(ARRAY(FCOUNT()),{|x,n| IF(FieldType(n) $ "CNDL",cCRC += ALLTRIM(XTOC(FieldGet(n))),NIL) })
RETURN CHECKSUM(cCRC)
//--------------------------------------------------------------------------//
                     FUNCTION GetProcessStation(cRecNo,cPath)
//--------------------------------------------------------------------------//
// Возвращает контрольный код на момент выполнения
STATIC nProcess
LOCAL cRandom1, cRandom2, cSumRandom
LOCAL cRandom3, cRandom4

IF nProcess = NIL

  cRandom1 :=  STR(RANDOM()%499+500,3,0)
  cRandom2 :=  STR(RANDOM()%499+500,3,0)
  cSumRandom := STR(VAL(cRandom1)+VAL(cRandom2),4,0)
  nProcess := VAL(CHARMIX(cRandom1+LEFT(cSumRandom,2),cRandom2+RIGHT(cSumRandom,2)))

ENDIF
RETURN nProcess
//--------------------------------------------------------------------------//
                    FUNCTION InfoCRC(cStatus)
//--------------------------------------------------------------------------//
// Возвращает признак корректности записи
// cStatus по ссылке
//   "1" - логический сбой
//   "2" - физический сбой
LOCAL cRandom1, cRandom2, cSumRandom, lRez := .T., lRecLock
IF FieldPos("CRC") != 0 .AND. ((lRecLock := (ASCAN(dbRLockList(),{|nRec| nRec = RECNO() }) != 0)) .OR. Bs_RLock())
  cSumRandom := LTRIM(STR(FIELD->CRC,10,0))
  cRandom1 := LEFT(CHARODD(cSumRandom),3)
  cRandom2 := LEFT(CHAREVEN(cSumRandom),3)
  cSumRandom := RIGHT(CHARODD(cSumRandom),2)+RIGHT(CHAREVEN(cSumRandom),2)
  IF GetInfoCRC() = FIELD->CRC
    lRez := .T.
  ELSEIF VAL(cSumRandom) = VAL(cRandom1)+VAL(cRandom2)
    cStatus := "1"
    lRez := .F.
  ELSE
    cStatus := "2"
    lRez := .F.
  ENDIF
  IF !lRecLock
    dbUnLock()
  ENDIF
ENDIF
RETURN lRez
//--------------------------------------------------------------------------//
                   FUNCTION SInfoCRC()
//--------------------------------------------------------------------------//
LOCAL cStatus := "1"
IF InfoCrc(@cStatus)
  RETURN "нормальная запись"
ENDIF
RETURN IF(cStatus = "1","логический сбой","физический сбой "+cStatus)
//
Static Function ExtractPath( cFull )
Local cDir, cName, cExt
hb_FNameSplit( cFull, @cDir, @cName, @cExt )
Return cDir

