*========================================================= * * FUNCTION: NewID * *========================================================= FUNCTION NewID * Created...........: 20.05.2004, 11:36 Uhr * Changed...........: 26.07.2002 * Standort-ID wahlweise über Feld * in der Tabelle * Description.......: Neue ID für eine Tabelle erzeugen * Calling Samples...: ? NewID(<ExpC>[,<ExpN>[,<ExpL1>[,<ExpL2>]]]) * Parameters........: tc_Key, tn_Len, tl_NoFill, tl_Numeric * Returns...........: Character or Numeric lparameters tc_Key, tn_Len, tl_NoFill, tl_Numeric, tl_KeepOpen LOCAL lcStandOrt, lc_ID, lc_OldReproc, ln_Len, ln_WasSel, lv_RetVal tc_Key = iif(vartype(tc_Key) = "C", tc_Key, alias()) tn_Len = iif(vartype(tn_Len) $ "IN", tn_Len, 10) tl_NoFill = iif(vartype(tl_NoFill) = "L", tl_NoFill, .F.) && fill with leading zeroes tl_Numeric = iif(vartype(tl_Numeric) = "L", tl_Numeric, .F.) && return numeric *-- Keep the Control-File open if it *-- was not used before? tl_KeepOpen= iif(vartype(tl_KeepOpen) = "L", tl_KeepOpen, .F.) ln_WasSel = select() lc_OldReproc = set("Reprocess") ll_WasUsed = used("CONTROL") ln_Len = tn_Len *-- initialize the Return-Value in case everything goes wrong lv_RetVal = iif(tl_Numeric, int(val( sys(3) )), sys(2015)) *-- See, if the Control-File exists *-- and if not, create it. if CheckControlFile() *-- Globale Standort-Variable *-- zur sicheren Unterscheidung *-- der Zähler if atc("SCHEDPROC", set("PROCEDURE")) = 0 set procedure to SCHEDPROC.PRG additive endif *-- Standort-Kennzeichen if ! CheckApplicationObject() lcStandOrt = "X" else lcStandOrt = goApp.cStandort endif set Reprocess to AUTOMATIC if ! ll_WasUsed use SCHEDULE!CONTROL in 0 endif select CONTROL *-- Key auf die Länge des Feldes *-- auffüllen, damit ich nicht versehentlich *-- mal falsch lande tc_Key = padr(upper(tc_Key),len(CONTROL.KEY_NAME)) if ! Seek(tc_Key, "CONTROL", "KEY_NAME") *-- Schlüssel nicht gefunden, dann anlegen *-- und mit 2 initialisieren. Die jetzt be- *-- nötigte ID ist dann 1 insert into CONTROL (KEY_NAME, VALUE, STANDORT, EDITABLE); values (tc_Key, str(2, len(CONTROL.VALUE)), goApp.lUseStandOrt, .F.) lc_ID = str(1, ln_Len) else if rLock("CONTROL") lc_ID = CONTROL.VALUE replace CONTROL.VALUE with str(val(allt(lc_ID))+1, len(CONTROL.VALUE)) unLock endif endif do case case tl_Numeric *-- Als integer zurückgeben lv_RetVal = int(val(lc_ID)) case ! tl_Numeric and tl_NoFill *-- nicht aufgefüllt if CONTROL.STANDORT ln_Len = ln_Len - len(lcStandOrt) lv_RetVal = lcStandOrt + padl(allt(lc_ID), ln_Len) else lv_RetVal = padl(allt(lc_ID), ln_Len) endif other *-- Character aufgefüllt mit Nullen if CONTROL.STANDORT ln_Len = ln_Len - len(lcStandOrt) lv_RetVal = lcStandOrt + padl(allt(lc_ID), ln_Len, "0") else lv_RetVal = padl(allt(lc_ID), ln_Len, "0") endif endcase if ! ll_WasUsed and ! tl_KeepOpen and used("CONTROL") use in CONTROL endif select (ln_WasSel) set repro to (lc_OldReproc) endif && CheckControlFile() return lv_RetVal *-- eof NewID *========================================================= * * PROCEDURE: CheckControlFile * *========================================================= PROCEDURE CheckControlFile * Created...........: 20.May 2004, 15:19 Uhr * Changed...........: * Description.......: Check, and if necessary create the ControlFile * Calling Samples...: ? CheckControlFile() * Parameters........: * Returns...........: boolean LOCAL lcFile, lcDBC lcDBC = dbc() if empty(lcDBC) if ! dbUsed("SCHEDULE") open data "SCHEDULE" endif set Database to SCHEDULE lcDBC = dbc() endif lcFile = addBS( JustPath(lcDBC) ) +"CONTROL.DBF" if ! file(lcFile) create Table (lcFile) ; ( KEY_NAME C(25) PRIMARY KEY,; VALUE C(25) ,; EDITABLE L ,; STANDORT L) use in ( JustStem(lcFile) ) endif return file(lcFile) *-- eop CheckControlFileHope this helps