>>>function GetNextID >>>lparameters tcAlias >>>local lnOldArea,lnNextID, lcDBC, lcOldSetDBC, llOpened, lcCurAlias >>>llOpened=.t. >>>*--- Variable Setup >>>lcCurAlias=upper(alias()) >>>if empty(m.lcCurAlias) >>> =messagebox("No table open...",16,"Error") >>> return null >>>endif >>>tcAlias = iif(empty(m.tcAlias),m.lcCurAlias,upper(m.tcAlias)) >>>lnOldArea = select() >>>lnNextID = 0 >>>lcDBC=cursorgetprop('database',m.tcAlias) && Return the name of owning database >>>if empty(m.lcDBC) >>> =messagebox('You can not assign Next ID to the free table!',16,'Warning') >>> return null >>>endif >>>lcOldSetDBC=set('database') && Save current status >>>if !dbused(m.lcDBC) >>> open data (m.lcDBC) >>> llOpened=.f. && Was not open before >>>endif >>>set database to (m.lcDBC) && Make this DBC current >>>*--- Go to NextID Database to assign the next unique ID >>>*--- Assumes the you are sitting in the correct DBC. >>>if !OpenTble(addbs(justpath(m.lcDBC))+juststem(m.lcDBC)+"!"+"NextID",,,"Table") >>> =messagebox('NextID could not be opened!',16,'Warning') >>> return null >>>endif >>>select NextID >>>if !seek(m.tcAlias) >>> insert into NextID (table,id) values (m.tcAlias,1) >>> lnNextID = 1 >>>else >>>*--- RLOCK will attempt the lock indefinately, because it would be bad to return 0 (the alternative). >>>*--- User will be able to cancel attempt if in a deadlock by pressing the ESC key. >>> if rlock() >>> replace NextID.id with NextID.id + 1 >>> lnNextID = NextID.id >>> unlock >>> else >>> return null >>> endif >>>endif >>>*--- Return to prior workarea. >>>select (m.lnOldArea) >>>if not m.llOpened >>> close database >>>endif >>>if !empty(m.lcOldSetDBC) >>> set database to (m.lcOldSetDBC) >>>endif >>>return m.lnNextID>>>