SetFont LoadFont("Arial",16)

;Максимальное количество столбцов
Const maxdbf=100
;Служебные переменные
Global dbfile,fleng,stpos,rowq,colq
;Массив для информации о столбцах
Dim dbc(maxdbf,1)

;Открытие базы данных
opendb "storage.dbf"
;Вывод базы данных на экран
For n=0 To rowq-1
 Print trimdbf$(n,0)+": "+trimdbf$(n,1)+"$, "+trimdbf$(n,2)+"pcs."
Next
;Закрытие базы данных
closedb

WaitKey

;Функция открытия файла базы данных
Function opendb(file$)
;Эта переменная будет хранить идентификатор файла
dbfile=OpenFile(file$)
SeekFile dbfile,8
;Начало блока данных
stpos=ReadShort(dbfile)
;Длина записи с данными (одной строки)
fleng=ReadShort(dbfile)
;Расчет количества строк
rowq=(FileSize(file$)-stpos)/fleng

;Счетчик количества столбцов
colq=0
;Позиция первой подзаписи - 1
dbc(0,0)=1
;Цикл по всем подзаписям полей
Repeat
 ;Адрес начала подзаписи
 fp=32*(colq+1)
 ;Выход, если встречен символ с кодом 13
 SeekFile dbfile,fp
 If ReadByte(dbfile)=13 Then Exit
 ;Считывание длины поля (в символах)
 SeekFile dbfile,fp+16
 dbc(colq,1)=ReadShort(dbfile)
 ;Расчет позиции поля
 If colq>0 Then dbc(colq,0)=dbc(colq-1,0)+dbc(colq-1,1)
 colq=colq+1
Forever
End Function

;Функция закрытия файла базы данных
Function closedb()
CloseFile dbfile
End Function

;Функция считывания данных из ячейки
Function dbf$(row,col)
;Определения адреса ячейки в файле
SeekFile dbfile,stpos+fleng*row+dbc(col,0)
;Формирование символьной переменной с данными ячейки
For n=1 To dbc(col,1)
 m$=m$+Chr$(ReadByte(dbfile))
Next
Return m$
End Function

;Функция, удаляющая в строке пробелы слева и справа
Function trimdbf$(row,col)
Return Trim$(dbf$(row,col))

Global dbfile,fleng,stpos,rowq,colq,dbbank
Dim dbc(maxdbf,1)

CopyFile "storage.dbf","storage2.dbf"
opendb "storage2.dbf"
For n=0 To rowq-1
 readrow n
 v=readdbf(1)
 writedbf 1,.88*v
 v=readdbf(1)
 writedbf 2,2*v
 writerow n
Next
closedb

opendb "storage2.dbf"
For n=0 To rowq-1
 readrow n
 Print trimdbf$(0)+": "+trimdbf$(1)+"$, "+trimdbf$(2)+"pcs."
Next
closedb

WaitKey

Function opendb(file$)
dbfile=OpenFile(file$)
SeekFile dbfile,8
stpos=ReadShort(dbfile)
fleng=ReadShort(dbfile)
rowq=(FileSize(file$)-stpos)/fleng

;Вспомогательный буфер для хранения строки
dbbank=CreateBank(fleng)

dbc(0,0)=1
colq=0
Repeat
 fp=32*(colq+1)
 SeekFile dbfile,fp
 If ReadByte(dbfile)=13 Then Exit
 SeekFile dbfile,fp+16
 dbc(colq,1)=ReadShort(dbfile)
 If colq>0 Then dbc(colq,0)=dbc(colq-1,0)+dbc(colq-1,1)
 colq=colq+1
Forever
End Function

Function closedb()
CloseFile dbfile
FreeBank dbbank
FreeBank dbbankc
End Function

;Функция чтения строки из файла в буфер
Function readrow(row)
;Определения адреса строки в файле
SeekFile dbfile,stpos+fleng*row
;Чтение данных из файла в буфер строки
ReadBytes dbbank,dbfile,0,fleng
End Function

;Функция записи строки из буфера строки в файл
Function writerow(row)
;Определения адреса строки в файле
SeekFile dbfile,stpos+fleng*row
;Запись данных из буфера строки в файл
WriteBytes dbbank,dbfile,0,fleng
End Function

;Функция считывания данных из ячейки буфера строки
Function readdbf$(col)
;Формирование символьной переменной с данными ячейки
For n=0 To dbc(col,1)-1
 m$=m$+Chr$(PeekByte(dbbank,dbc(col,0)+n))
Next
Return m$
End Function

;Функция записи данных в ячейку буфера строки
Function writedbf(col,m$)
;Побайтовая запись из строковой переменной в буфер
l=Len(m$)
For n=0 To dbc(col,1)-1
 If n<l Then v=Asc(Mid$(m$,n+1,1)) Else v=32
 PokeByte dbbank,n+dbc(col,0),v
Next
End Function

;Обрезка пробелов справа и слева
Function trimdbf$(col)
Return Trim$(readdbf$(col))

 Field name$
 Field price#
 Field quantity
End Type

Const maxdbf=100
Global dbfile,fleng,stpos,rowq,colq,dbbank,dbbankc
Dim dbc(maxdbf,1)

opendb "storage.dbf"
For n=0 To rowq-1
 readrow n
 r.baserow=New baserow
 r\name$=readdbf(0)
 r\price#=readdbf(1)
 r\quantity=readdbf(2)
 For r2.baserow=Each baserow
  If r2\name$>r\name$ Then Insert r Before r2:Exit
 Next
Next
closedb

createdb "storage2.dbf"
addfield "NAME",51
addfield "PRICE($)",9
addfield "QUANTITY",9
addfield "TOTAL",9
closeheader

For r=Each baserow
 clearbnk
 writedbf 0,r\name$
 writedbf 1,r\price#
 writedbf 2,r\quantity
 writedbf 3,r\quantity*r\price
 addrow
Next
closedb

opendb "storage2.dbf"
For n=0 To rowq-1
 readrow n
 Print trimdbf$(0)+": "+trimdbf$(2)+"pcs."+trimdbf$(1)+"$, total:"+trimdbf$(3)+"$"
Next
closedb

WaitKey

Function opendb(file$)
dbfile=OpenFile(file$)
SeekFile dbfile,8
stpos=ReadShort(dbfile)
fleng=ReadShort(dbfile)
rowq=(FileSize(file$)-stpos)/fleng

;Вспомогательный буфер для хранения строки
dbbank=CreateBank(fleng)
;Создание и инициализация банк для очистки буфера
dbbankc=CreateBank(fleng)
For n=0 To fleng-1
 PokeByte dbbankc,n,32
Next

dbc(0,0)=1
colq=0
Repeat
 fp=32*(colq+1)
 SeekFile dbfile,fp
 If ReadByte(dbfile)=13 Then Exit
 SeekFile dbfile,fp+16
 dbc(colq,1)=ReadShort(dbfile)
 If colq>0 Then dbc(colq,0)=dbc(colq-1,0)+dbc(colq-1,1)
 colq=colq+1
Forever
End Function

Function closedb()
;Запись количества строк перед закрытием базы
SeekFile dbfile,4
WriteInt dbfile,rowq
CloseFile dbfile
FreeBank dbbank
FreeBank dbbankc
End Function

Function readrow(row)
SeekFile dbfile,stpos+fleng*row
ReadBytes dbbank,dbfile,0,fleng
End Function

Function writerow(row)
SeekFile dbfile,stpos+fleng*row
WriteBytes dbbank,dbfile,0,fleng
End Function

Function readdbf$(col)
For n=0 To dbc(col,1)-1
 m$=m$+Chr$(PeekByte(dbbank,dbc(col,0)+n))
Next
Return m$
End Function

Function writedbf(col,m$)
l=Len(m$)
For n=0 To dbc(col,1)-1
 If n<l Then v=Asc(Mid$(m$,n+1,1)) Else v=32
 PokeByte dbbank,n+dbc(col,0),v
Next
End Function

Function trimdbf$(col)
Return Trim$(readdbf$(col))
End Function

;Функция создания новой базы данных
Function createdb(file$)
dbfile=WriteFile(file$)
;Номер версии DBase - 4, дата - первое января 2000г (можно любую)
WriteInt dbfile,3+1 Shl 8+1 Shl 16
;Остальную часть заголовка пока обнулим
For n=1 To 7
 WriteInt dbfile,0
Next
stpos=32
fleng=1
rowq=0
End Function

;Добавление нового столбца
Function addfield(name$,l)
;Запись имени поля
For n=1 To 11
 WriteByte dbfile,Asc(Mid$(name$,n,1))
Next
;Тип поля-символьное (C)
WriteByte dbfile,67
;Запись позиции поля в строке
WriteInt dbfile,fleng
f=(stpos Shr 5)-1
dbc(f,0)=fleng
;Запись длины поля
WriteShort dbfile,l
dbc(f,1)=l
;Остальные заполняются нулями
For n=1 To 7
 WriteShort dbfile,0
Next
fleng=fleng+l
stpos=stpos+32
End Function

;Функция, закрывающая заголовок
Function closeheader()
;Символ конца заголовка
WriteByte dbfile,13
SeekFile dbfile,8
;Запись позиции начала данных
stpos=stpos+1
WriteShort dbfile,stpos
;Запись длины записи с данными
WriteShort dbfile,fleng

;Подготовка банков
dbbank=CreateBank(fleng)
dbbankc=CreateBank(fleng)
For n=0 To fleng-1
 PokeByte dbbankc,n,32
Next
End Function

;Функция, добавляющая строку в базу данных
Function addrow()
SeekFile dbfile,stpos+fleng*rowq
WriteBytes dbbank,dbfile,0,fleng
rowq=rowq+1
End Function

;Функция очистки буфера строки
Function clearbnk()
CopyBank dbbankc,0,dbbank,0,fleng

Dim dbfile(dbq),fleng(dbq),stpos(dbq),rowq(dbq),colq(dbq),dbbank(dbq),dbbankc(dbq)
Dim dbc(dbq,maxdbf,1)

Function opendb(db,file$)
f=OpenFile(file$)
dbfile(db)=f
SeekFile f,8
stpos(db)=ReadShort(f)
fleng(db)=ReadShort(f)
rowq(db)=(FileSize(file$)-stpos(db))/fleng(db)

dbbank(db)=CreateBank(fleng(db))
dbbankc(db)=CreateBank(fleng(db))
For n=0 To fleng(db)-1
 PokeByte dbbankc(db),n,32
Next

dbc(db,0,0)=1
cq=0
Repeat
 fp=32*(cq+1)
 SeekFile f,fp
 If ReadByte(f)=13 Then Exit
 SeekFile f,fp+16
 dbc(db,cq,1)=ReadShort(f)
 If colq(db)>0 Then dbc(db,cq,0)=dbc(db,cq-1,0)+dbc(db,cq-1,1)
 cq=cq+1
Forever
colq(db)=cq
End Function

Function closedb(db)
f=dbfile(db)
SeekFile f,4
WriteShort f,rowq(db)
CloseFile f
FreeBank dbbank(db)
FreeBank dbbankc(db)
End Function

Function readrow(db,row)
SeekFile dbfile(db),stpos(db)+fleng(db)*row
ReadBytes dbbank(db),dbfile(db),0,fleng(db)
End Function

Function writerow(db,row)
SeekFile dbfile(db),stpos(db)+fleng(db)*row
WriteBytes dbbank(db),dbfile(db),0,fleng(db)
End Function

Function readdbf$(db,col)
For n=0 To dbc(db,col,1)-1
 m$=m$+Chr$(PeekByte(dbbank(db),dbc(db,col,0)+n))
Next
Return m$
End Function

Function writedbf(db,col,m$)
l=Len(m$)
For n=0 To dbc(db,col,1)-1
 If n<l Then v=Asc(Mid$(m$,n+1,1)) Else v=32
 PokeByte dbbank(db),n+dbc(db,col,0),v
Next
End Function

Function trimdbf$(db,col)
Return Trim$(readdbf$(db,col))
End Function

Function createdb(db,file$)
dbfile(db)=OpenFile(file$)
WriteInt dbfile(db),3+1 Shl 8+1 Shl 16
For n=1 To 7
 WriteInt dbfile(db),0
Next
stpos(db)=32
fleng(db)=1
rowq(db)=0
End Function

Function addfield(db,name$,l)
f=dbfile(db)
For n=1 To 11
 WriteByte f,Asc(Mid$(name$,n,1))
Next
WriteByte f,66
WriteInt f,fleng(db)
fld=(stpos(db) Shr 5)-1
dbc(db,fld,0)=fleng(db)
WriteShort f,l
dbc(db,fld,1)=l
For n=1 To 7
 WriteShort f,0
Next
fleng(db)=fleng(db)+l
stpos(db)=stpos(db)+32
End Function

Function closeheader()
f=dbfile(db)
WriteByte f,13
SeekFile f,8
stpos(db)=stpos(db)+1
WriteShort f,stpos(db)
WriteShort f,fleng(db)
End Function

Function addrow(db)
SeekFile dbfile(db),stpos(db)+fleng(db)*rowq(db)
WriteBytes dbbank(db),dbfile(db),0,fleng(db)
rowq(db)=rowq(db)+1
End Function

Function clearbnk(db)
CopyBank dbbankc(db),0,dbbank(db),0,fleng(db)