свиване
Примерна програма за свиване
: A_TEST_CREATEIMP.PRG
: команда implode(действие,указания..)
: 1. запис
: implode ('init',filename,fullcomplect)
: implode ('col',col_num,indexfilename,index_offset,indextype)
:          where indextype = 'D','D2' (disk index files) or 'M','M1','M2' (memory indexing)
:          index_offset must be 0 or -1,-2.. when indextype is 'D2' or 'M2'
:          and col_num+index_offset must be typed as 'D' or 'M1'
: for fullcomplect only 'M' indextypes are valid
: implode ('analize')
: implode ('write')
: implode ('close')

: 2. четене
: implode ('open',filename)
: implode ('read')
: implode ('close')

база m
копи . m1
база m1

имп_име 'proben'
имп_име_т имп_име+'.imp'
имп_име_б имп_име+'.bag'
имп_име_ф имп_име+'.fmt'
имп_име_г имп_име+'.ifm'
имп_име_к имп_име+'.b4z'
имп_опис 'opis_proben'

индекс_в_паметта 1
двойни_индекси 1
пълен_комплект 0
междинна_торба 0

ако междинна_торба=0 то създай @имп_опис(50)
прдоклад 'init...'
implode('init',имп_име_т,пълен_комплект)
к 1
10 :
индексен 'index'+formatn(к,2,0,2)+'.b4i'
колона_офсет 0
ако индекс_в_паметта
 тип_индекс 'M'
 ако двойни_индекси
  ако (к=4) or (к=6)
   тип_индекс 'M1'
  крайако
  ако (к=5) or (к=7)
   индексен '*'
   тип_индекс 'M2'
   колона_офсет -1
  крайако
 крайако
иначе
 тип_индекс 'D'
 ако двойни_индекси
  ако (к=5) or (к=7)
   индексен '*'
   тип_индекс 'D2'
   колона_офсет -1
  крайако
 крайако
крайако
ако тип_индекс<>'' то implode('col',к,индексен,колона_офсет,тип_индекс)
к к+1
ако к<=countcc(0) то преход 10

прдоклад 'analize...'
implode('analize')
implode('write')
физтр @имп_име_б
прмт cbasename(0)
ако пълен_комплект=0
 ако междинна_торба
  bag (имп_име_б,'N',имп_име_т,имп_име_ф)
  bag (имп_име_б,'+',имп_име_г)
 иначе
  база @имп_опис
  добави 3
  поле (countrr(0)-2,1)=имп_име_т
  поле (countrr(0)-1,1)=имп_име_ф
  поле (countrr(0),1)=имп_име_г
  база @прмт
 крайако
 к 1
 200 : събира всичко в торбата имп_име_б
 индексен_ 'index'+formatn(к,2,0,2)
 индексен_т индексен_+'.b4i'
 ако existfs(индексен_т)
  индексен_ф индексен_+'.fmt'
  ако междинна_торба
   bag (имп_име_б,'+',индексен_т,индексен_ф)
  иначе
   база @имп_опис
   добави 2
   поле (countrr(0)-1,1)=индексен_т
   поле (countrr(0),1)=индексен_ф
   база @прмт
  крайако
 крайако
 к к+1
 ако к<=countcc(0) то преход 200
крайако
прдоклад 'write...'
ако междинна_торба 
 bag (имп_име_б,'W',имп_име_к)
иначе
 база @имп_опис
 отрезф(1,0)
 bag ('','Z',имп_име_к)
 база @прмт
крайако

implode('close')
физтр @имп_име_б
физтр @имп_име_г
изтр @имп_име_т
ако междинна_торба=0 то изтр @имп_опис
база m1

===================край=====================