>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>