************* FUNCTION NewID
*****************************************************************************
* Описание	:	Создание суррогатного первичного ключа в  36 -ричной
*				системе исчисления символьного типа.
* Необходимо:	Таблица SYSTEM со структурой TagName (C10) ASC; UPPER,
*				Value (C{самое_длинное_ключевое_поле_в_БД})
*				Значение ключа - существующее значение поля SYSTEM.VALUE
*               Таблица system остается открытой
* Параметры	:	Псевдоним таблицы, для которой генерируется ключ.
*				Если параметр опущен - генерируется ключ для текущей таблицы
* Возрат	: 	lcID {символьное значение}
*****************************************************************************
*----------------------------------------------------------------------------
* Внесены изменения:
* В БД system добавлено поле TYPE
* если оно равно "HEX" вызывается процедура генерации  36 -ричного ключа
* если оно равно "DEC" вызывается процедура генерации целого ключа "counter"
* если оно равно "STR" вызывается процедура генерации  10 -ричного ключа
*
PARAMETER tcAlias, tcSystemAlias, tlNoDelay

PRIVATE lcAlias, lcID, lcOldReprocess, lnOldArea, lnID, M.n_sec

lnOldArea=SELECT()

IF PARAMETERS()< 1 
	lcAlias=UPPER(ALIAS())
ELSE
	lcAlias=UPPER(tcAlias)
ENDIF
IF EMPTY(tcSystemAlias)
	tcSystemAlias="SYSTEM"
ENDIF

lcID=''
lcOldReprocess=SET('REPROCESS')
SET REPROCESS TO AUTOMATIC

IF !USED(tcSystemAlias)
	USE system.dbf IN  0  AGAIN ALIAS (tcSystemAlias)
ENDIF
SELECT (tcSystemAlias)
SET ORDER TO TagName

* задержка в  1  сек. перед взятием нового ключа
* для обновления данных в таблице system
* от других пользователей

IF !tlNoDelay
	M.n_sec=SECONDS()
	DO WHILE SECONDS()-M.n_sec <  1 
	ENDDO
ENDIF

IF SEEK(lcAlias,tcSystemAlias,'tagname')
	IF RLOCK()
		DO CASE 
		CASE &tcSystemAlias..type="HEX"
			lcID=ALLTRIM(&tcSystemAlias..value)
			REPLACE &tcSystemAlias..value WITH GenerateKey(ALLTRIM(&tcSystemAlias..value)) && процедура генерации ключа
		CASE &tcSystemAlias..type="DEC"
			lcID=INT(VAL(&tcSystemAlias..value))
			REPLACE &tcSystemAlias..value WITH PADL(lcID+ 1 ,FSIZE("value"),"0")
		CASE &tcSystemAlias..type="STR"
			lcID=ALLTRIM(&tcSystemAlias..value)
			lnID=INT(VAL(&tcSystemAlias..value))
			REPLACE &tcSystemAlias..value WITH PADL(lnID+ 1 ,LEN(lcID),"0")
		OTHERWISE	&& аналог "HEX"
			lcID=ALLTRIM(&tcSystemAlias..value)
			REPLACE &tcSystemAlias..value WITH GenerateKey(ALLTRIM(&tcSystemAlias..value)) && процедура генерации ключа
		ENDCASE
		UNLOCK
	ELSE
		=Islocked()
		=Alert("Не могу заблокировать таблицу генерации ключей!"+;
		      " Генерация нового ключа сейчас невозможна")
	ENDIF
ELSE
	INSERT INTO (tcSystemAlias) (tagname, value, type) ;
		VALUES (lcAlias, PADL("0",FSIZE("value"),"0"), "HEX")
	lcID=ALLTRIM(&tcSystemAlias..value)
	REPLACE &tcSystemAlias..value WITH GenerateKey(ALLTRIM(&tcSystemAlias..value)) && процедура генерации ключа
	=Alert("Таблица "+lcAlias+" не найдена в БД генерации ключей. "+ ;
		"Новая запись была создана автоматически. Сообщите разработчикам!")
ENDIF

FLUSH

SELECT (lnOldArea)
SET REPROCESS TO lcOldReprocess
RETURN lcID


***************************************************************************
*	Непосредственная генерация  36 -ричного значения
***************************************************************************
FUNCTION GenerateKey
PARAMETERS tcValue
#DEFINE	NINE		 57 			&& ASC('9')
#DEFINE	CAP_Z		 90 			&& ASC('Z')
#DEFINE	LOW_Z		 122 			&& ASC('z')
#DEFINE	KEY_SPACE	 32 			&& ASC(' ')

PRIVATE lnDigit, lnStringLenght, lnChar, lcCar, lcID, lcValue

lcValue=tcValue
lcID=''

* Цикл обратного просмотра ключа для увеличения его на  1 
lnStringLength=LEN(lcValue)
FOR lnDigit=lnStringLength TO  1  STEP - 1 
	lnChar=ASC(SUBSTR(lcValue,lnDigit, 1 ))
	IF lnChar=CAP_Z		&&  36 -ричная система
		lcValue=LEFT(lcValue,lnDigit- 1 )+ ;
			'0'+RIGHT(lcValue,lnStringLength-lnDigit)
	ELSE
		DO CASE
			CASE lnChar=NINE
				lcChar='A'
			CASE lnChar=CAP_Z
				lcChar='a'
			CASE lnChar=KEY_SPACE
				lcChar='1'
			OTHERWISE
				lcChar=CHR(lnChar+ 1 )
		ENDCASE
		lcID=LEFT(lcValue,lnDigit- 1 )+ ;
			lcChar+ ;
			RIGHT(lcValue,lnStringLength-lnDigit)
		EXIT
	ENDIF
ENDFOR

IF EMPTY(lcID)
	lcID=REPLICATE('0',lnStringLength- 1 )+'1'
ENDIF
RETURN lcID