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

#IF  "2 . 6 "$VERSION()
	PRIVATE lcAlias, lcID, lcOldReprocess, lnOldArea, lnID, lnSec
#ELSE
	LOCAL lcAlias, lcID, lcOldReprocess, lnOldArea, lnID, lnSec
#ENDIF

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

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