* NCtrlNo.PRG
* --- 生成系统控制号
PARAMETERS lcField, lcTable
* --- 控制号字段名，表名
PRIVATE ALL EXCEPT B*
* --- 避免因找不到 BOOX 而出错
IF EMPTY(lcField)
lcField = ORDER()
ENDIF
IF EMPTY(lcTable)
lcTable = UPPER(ALLTRIM(ALIAS()))
ENDIF
lcField = UPPER(ALLTRIM(lcField))
lcTable = UPPER(ALLTRIM(lcTable))
IF NOT USED(lcTable)
=MessageBox("程序错误，无指定的数据表，无法生成控制号")
CLOSE DATABASE
CLEAR WINDOW
RETURN TO MASTER
ENDIF
DECLARE aFldInfo[1]
nRows = AFIELDS(aFldInfo, lcTable)
nRow = 0
cFldType = "U"
FOR i = 1 TO nRows
IF aFldInfo[i, 1] = UPPER(lcField)
nRow = i
cFldType = aFldInfo[nRow, 2]
EXIT
ENDIF
ENDFOR
IF nRow = 0 OR NOT cFldType $ "IN"
=MessageBox("程序错误，当前非数值字段索引，无法生成控制号")
RETURN TO MASTER
ENDIF
IF cFldType = "I"
nMaxNo = 2^32 - 1
ELSE
nMaxNo = EVALUATE(REPLICATE("9", FSIZE(lcField, lcTable)))
ENDIF
IF NOT MyFile("CCtrlNo.DBF")
=MessageBox("系统缺少必备数据库:" + CHR(13) + CHR(13) + "CCtrlNo.DBF" + CHR(13) + CHR(13) + "请与系统管理员联系解决!", 16, "生成控制号出错")
RETURN TO MASTER
ENDIF
cOldError = ON("ERROR")
ON ERROR *
USE CCtrlNo EXCLUSIVE IN 0
DO WHILE NOT USED("CCtrlNo")
USE CCtrlNo EXCLUSIVE IN 0
ENDDO
ON ERROR &cOldError
DECLARE aMaxCtrlNo[1]
SELECT MAX(&lcField) FROM (lcTable) INTO ARRAY aMaxCtrlNo
IF _TALLY = 0
nNewCtrlNo = 1
ELSE
nNewCtrlNo = aMaxCtrlNo[1] + 1
ENDIF
IF nNewCtrlNo > nMaxNo
USE IN CCtrlNo
CLEAR TYPEAHEAD
=MessageBox("控制号生成溢出!"+CHR(13) + CHR(10) + "本系统控制号最大数超过 "+ALLTRIM(STR(nMaxNo))+" !", 16, "严重错误")
RETURN TO MASTER
ENDIF
RETURN nNewCtrlNo
|
