Visual Foxproda index kırılması

Function NewID

    Lparameters tcAlias,tnCount

    Local lcAlias, lnOldArea, lcOldReprocess, lcTable, lnTagNo, lnNewValue, lnLastValue, lcOldSetDeleted

    lnOldArea = Select()

    lnOldReprocess = Set('REPROCESS')

    * Uppercase Alias name

    lcAlias = Upper(Iif(Parameters() = 0, Alias(), tcAlias))

    * Lock reprocess - try once

    Set Reprocess To 1

    If !Used("IDS")

        Use ids In 0

    Endif

    * If no entry yet create

    If !Seek(lcAlias, "Ids", "tablename")

        Insert Into ids (tablename, NextID) Values (lcAlias,0)

    Endif

    * Lock, increment id, unlock, return nextid value

    Do While !Rlock('ids')

        * Delay before next lock trial

        lnStart = Seconds()

        Do While Seconds()-lnStart < 0.01

        Enddo

    Enddo

 

    lnLastValue = ids.NextID

    lnNewValue  = m.lnLastValue + Evl(m.tnCount,1)

 

    *Try to query primary key tag for lcAlias

    lcTable = Iif( Used(lcAlias),Dbf(lcAlias), Iif(File(lcAlias+'.dbf'),lcAlias,''))

    lcTable = Evl(m.lcTable,m.lcAlias)

    If !Empty(lcTable)

        Use (lcTable) In 0 Again Alias '_GetPKKey_'

        For m.lnTagNo=1 To Tagcount('','_GetPKKey_')

            If Primary(m.lnTagNo,'_GetPKKey_')

                m.lcOldSetDeleted = Set("Deleted")

                Set Deleted Off

 

                Select '_GetPKKey_'

                Set Order To Tag (Tag(m.lnTagNo,'_GetPKKey_')) ;

                    In '_GetPKKey_' Descending

                Locate

                lnLastValue = Max(m.lnLastValue, Evaluate(Key(m.lnTagNo,'_GetPKKey_')))

                lnNewValue = m.lnLastValue + Evl(m.tnCount,1)

 

                If Upper(m.lcOldSetDeleted) == 'ON'

                    Set Deleted On

                Endif

                Exit

            Endif

 

        Endfor

        Use In '_GetPKKey_'

        Select ids

    Endif

 

    * Increment

    Replace ids.NextID With m.lnNewValue In 'ids'

    Unlock In 'ids'

    Select (lnOldArea)

    Set Reprocess To lnOldReprocess

    Return ids.NextID

Endfunc

open database dbName

lnID = NewID("Musteriler") && musteriler icin 1 ID al

lnID = NewID("Musteriler", 10) && musteriler icin blok 10 ID al - gelen kullanacagin son numara. 88 geldiyse 88-10+1 ilk. 79-88 senin

NewID("TabloAdi")

Lparameters tcTableName, tnCount

IF VARTYPE(oApp)!='O' AND VARTYPE(_screen.oApp) = 'O'

    oApp = _screen.oApp

endif

 

Local loConn as 'ADODB.Connection',loCommand as 'ADODb.Command',loRS as 'ADODb.RecordSet',lnReturn

loConn = Createobject('ADODB.Connection')

loCommand = Createobject('ADODB.Command')

loConn.ConnectionString = oApp.ADODataConnectionString

loConn.Open

loCommand.ActiveConnection = loConn

loCommand.CommandType = 4 && stored procedure

Do Case

    Case oApp.DataMode == 'SQL'

        loCommand.CommandText = 'NextID'

        loCommand.Parameters.Refresh

        loCommand.Parameters('@tableName').Value = m.tcTableName

        loCommand.Parameters('@nRows').Value = EVL(m.tnCount,1)

        loCommand.Execute

        lnReturn = loCommand.Parameters('@end').Value

    Case oApp.DataMode == 'VFP'

        loCommand.CommandText = Textmerge('NewID("<<m.tcTableName>>",<<EVL(m.tnCount,1)>>)')

        loRS = loCommand.Execute

        lnReturn = loRS.Fields(0).Value

        loRS.Close

Endcase

loConn.Close

Return m.lnReturn