Many years ago (circa A5V4) Cal Locklin (possibly with some input from Ira Perlow) came up with an auto increment scheme and function to use in place of what Alpha gives us. All of that was shared on whatever board existed at that time. If it is somewhere on this board, I can't find it. In any case, I borrowed it in 2003, made a few changes (possibly switching it to use a numeric ID) and successfully used it in several of my apps for many years. One problem it is attempting to do away with is the possibility of orphaned child records being linked to a new (and incorrect) parent record. With Cal's permission I am here sharing the function, along with a sample database showing how to set it up.
Raymond Lyons
Raymond Lyons
Code:
'Date Created: 29-Apr-2003 05:30:06 PM
'Last Updated: 01-Jul-2009 10:15:47 PM
'Created By : Cal Lockin, minor changes by Ray Lyons
'Updated By : Raymond Lyons
FUNCTION AUTO_incr_n AS N (Next_n_tblname AS C, autoincr_fldname as C, autoincr_fld_dflt_val AS N)
'Description:Use field value in one record table to auto increment the value of an ID field (autoincr_fldname) for a new record.
'Note: This entire method is something that was originated by Cal Loklin and, I think, Ira Perlow way back in the
'the v4 days. I (Ray Lyons) made few if any changes, possibly just to make it numeric for my purposes and change the messages.
'In this case the incremented value is numeric but could be easily changed to character.
'Need to have a 1 record, 1 field table. For example, table ="auto_incr_no" with a numeric field
'named "Next_ID" with a length of, say, 10. Set a starting value of 0, 1 or whatever.
'For the table needing an auto-incremented ID field (e.g., "My_auto_ID"), we need a field rule.
'Data Entry: Simple default expression, default value = 0 and set default value at start of data entry.
'Set Skip =.T.
'Validations: Value of field must be unique.
'In this example, Events, Record Events, Event: CanSaveRecord = auto_incr_n("a_incr_no","MY_auto_ID",0)
'Get a pointer to the field in this local table.
tbl = table.current()
fld = tbl.field_get(autoincr_fldname)
Restart_here:
'Increment the field value.
IF fld.value_get() = autoincr_fld_dflt_val
'The incr_fld_value() function returns the current Character value in "Next_n_tblname" and
'increments it by 1. If it is not able to open the "Next_n_tblname" it returns the original
'"autoincr_fld_dflt_val" so it can be checked below.
newval = incr_fld_value( Next_n_tblname, autoincr_fld_dflt_val )
fld.value_put(newval)
END IF
'Not really necessary. Just allows the function to return something meaningful.
Auto_incr_n = fld.value_get()
'If increment didn't succeed, allow trying again or cancelling.
'This allows for the possibility that someone is working directly on the table or it has
'been left 'permanently' open for some reason such as another computer crashing at the
'wrong time.
IF fld.value_get() = autoincr_fld_dflt_val
msg = "The ID number cannot be incemented because the file used to "
msg = msg + "increment it ('"+Next_n_tblname+"') is in use. "
msg = msg + "Someone else could be using the table or it could be locked due to "
msg = msg + "a previous system crash somewhere on the network." +chr(13)+chr(13)
msg = msg + "If nobody else is using the file, it may be necessary for everyone to "
msg = msg + "shut down and re-boot. In extreme cases, it may even be necessary to "
msg = msg + "re-boot the server." +chr(13)+chr(13)+ "To try again up to 3 times, click 'OK'. To "
msg = msg + "quit and lose this record, click 'Cancel'."
resp = ui_msg_box( "*** ERROR - Record NOT saved ***", msg, 16+ui_ok_cancel )
IF resp = ui_ok_selected
GOTO Restart_here
END IF
'This seems to work even *after* the message box. It didn't in version 4.
cancel()
END
END IF
END FUNCTION
FUNCTION Incr_fld_value AS N ( tablename AS C, init_val as N )
'Description:Returns current value in field 1 of 'tablename' and increments it by one. Used to implement xbasic autoincrement in CanSave Record event.
DIM curval as N
'If exclusive access isn't obtained, this returns the initial value so
'the field value won't be changed. Add'l checks will be run in the main function above.
Incr_fld_value = init_val
error_loops = 0
ON ERROR GOTO Not_exclusive
tp = table.open(tablename,file_rw_exclusive)
' ON ERROR GOTO 0
tp.fetch_goto(1)
fld = tp.field_get(1) 'Get a pointer to the first field in the record.
curval = fld.value_get()
newval = increment_value(curval)
'Store the next value in the increment table.
tp.change_begin()
fld.value_put(newval)
tp.change_end()
tp.close()
Incr_fld_value = curval
EXIT FUNCTION
Not_exclusive:
'Give it 3 tries in case someone else is entering a record at exactly the same time.
ui_msg_box("Attempting to Save", "On this attempt (" + ltrim(str(error_loops+1))+") there was a problem that may clear up momentarily. Please click OK to try again up to 3 more times.")
IF error_loops < 2
error_loops = error_loops + 1
RESUME 0
END IF
END FUNCTION
Comment