Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Creating a code sequence
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Divers
Thread ID:
01046401
Message ID:
01046426
Vues:
21
This message has been marked as a message which has helped to the initial question of the thread.
Moises!

here is my Code. As I said it has a lot of Extra-stuff, You don't need. But I'm sure You can take the important parts out of it.

some comments are in German.

This one works for a distributed environment where we also interchange Data. This is why we
have the "Standort". It is an office-specific prefix. You won't need this.

It also allows for Character-ID's ("0000123") as well as numeric (123)
*=========================================================
*
*         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 CheckControlFile
Hope this helps
Regards from Berlin

Frank

Dietrich Datentechnik (Berlin)
Softwarekombinat Teltow (Teltow)

Frank.Dietrich@dd-tech.de
DFPUG # 327
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform