That seems to do the basic functions. The size of the text base is almost the same as dbf, and the velocity of the read and write is almost 3 times faster
Code: Select all
#include "Fileio.ch" // Max_DB
PROCEDURE AppSys
// Рабочий стол остается окном приложения
RETURN
******************************************************************
FUNCTION Main()
LOCAL Getlist := {}, oProgress, oDialog
DC_IconDefault(1000)
**** Опрделение максимальной длины текстовой переменной для строки базы данных
**mTXT = ""
*DO WHILE .T.
* mTXT = mTXT + REPLICATE("#",1000000)
*ENDDO
* Оказалось текстовая переменная может содержать до 282 млн.символов. Этого более чем достаточно
CrLf = CHR(13)+CHR(10) // Конец строки (записи)
N_Cls = 5 // Число классов
N_Rec = 20 // Число признаков
DB_name = "Max_DB.txt" // Имя базы данных
N_Col = N_Cls+3 // Число полей
********** Структура создаваемой базы
aStructure := { { "Kod_pr", "N", 15, 0},; // 1
{ "Name" , "C", 15, 0} } // 2
FOR j=1 TO N_Cls
FieldName = "N"+ALLTRIM(STR(j,15))
AADD(aStructure, { FieldName, "N", 19, 2 })
NEXT
AADD(aStructure, { "Summa", "N", 19, 2 })
**************************************
DC_ASave(aStructure, "_AbsStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать
*aStructure = DC_ARestore("_AbsStruct.arx")
nHandle := FCreate( DB_name, FC_NORMAL ) // Создание БД (если она была, то все равно создается пустая) ######
*nHandle := FOpen( DB_name, FO_READWRITE ) // Открытие базы данных ############################################
IF nHandle = -1
MsgBox("Файл: "+DB_name+" не может быть создан. Ошибка:"+FERROR())
RETURN NIL
ENDIF
****** Формирование пустой записи
Lc_buf = ""
FOR j=1 TO N_Col
S = IF(j=2*INT(j/2),"#","X")
IF aStructure[j,4] = 0
Lc_buf = Lc_buf + REPLICATE(S, aStructure[j,3])
ELSE
Lc_buf = Lc_buf + REPLICATE(S, aStructure[j,3]-aStructure[j,4]-1)+"."+REPLICATE(S, aStructure[j,4])
ENDIF
NEXT
Lc_buf = Lc_buf + CrLf
Len_LcBuf = LEN(Lc_buf)
LC_DbCreate( DB_name, nHandle, Lc_buf, N_Rec ) // Создание БД.txt, содержащей N_Rec пустых записей ############
DbCreate( "Max_DB", aStructure ) // Создание пустой БД.dbf
**** Рассет массива начальных позиций полей в строке
PRIVATE aPos[N_Col]
aPos[1] = 1
FOR j=2 TO N_Col
aPos[j] = aPos[j-1] + aStructure[j-1,3]
NEXT
*** Отображение начальных позиций полей (отладка)
*aM := {}
*FOR j=1 TO N_Col
* AADD(aM, STR(j)+" "+STR(aPos[j]))
*NEXT
*LB_Warning(aM)
*** Запись поля в БД (корректная) ***********
FOR i=1 TO N_Rec
FOR j=1 TO N_Col
IF aStructure[j,4] = 0
String = STR(i*1000+j,aStructure[j,3])
ELSE
String = STR(i*1000+j+0.12,aStructure[j,3],aStructure[j,4])
ENDIF
Flag_err = LC_FieldPut( DB_name, nHandle, i, j, String ) // Запись поля в БД (корректная) #####################
IF Flag_err
EXIT
ENDIF
NEXT
NEXT
*Flag_err = LC_FieldPut( DB_name, nHandle, Pos, String ) // Запись поля в БД (некорректная)
*** Считывание поля в БД (корректная) ***********
*** Формирование БД.dbf (для отладки)
USE Max_DB EXCLUSIVE NEW;ZAP
SELECT Max_DB
DBGOTOP()
FOR j=1 TO N_Rec
APPEND BLANK
NEXT
FOR i=1 TO N_Rec
FOR j=1 TO N_Col
String = LC_FieldGet( DB_name, nHandle, i, j ) // Считывание поля из БД (корректная) ################
DO CASE
CASE aStructure[j,2] = "C"
DBGOTO(i);FIELDPUT(j, String ) // Для отладки
CASE aStructure[j,2] = "N"
DBGOTO(i);FIELDPUT(j, VAL(String) ) // Для отладки
ENDCASE
IF EMPTY(String)
EXIT
ENDIF
NEXT
NEXT
*String = LC_FieldGet( DB_name, nHandle, Pos ) // Считывание поля из БД (некорректная)
******* Эксперимент по определеию скорости обращения к базам данных TXT и DBF
nTimeON := SECONDS()
FOR i=1 TO N_Rec
FOR j=1 TO N_Col
String = LC_FieldGet( DB_name, nHandle, i, j ) // Считывание поля из БД (корректная) ################
Flag_err = LC_FieldPut( DB_name, nHandle, i, j, String ) // Запись поля в БД (корректная) #####################
NEXT
NEXT
nTimeOFF := SECONDS()
MsgBox("Время исполнения для БД.TXT="+ALLTRIM(STR(nTimeOFF-nTimeON))+" сек.")
nTimeON := SECONDS()
SELECT Max_DB
FOR i=1 TO N_Rec
FOR j=1 TO N_Col
DBGOTO(i);Str = FieldGet( j )
DBGOTO(i);FIELDPUT(j, Str )
NEXT
NEXT
nTimeOFF := SECONDS()
MsgBox("Время исполнения для БД.DBF="+ALLTRIM(STR(nTimeOFF-nTimeON))+" сек.")
*** Результат: обращение к на чтение и запись происходит БД.txt почти в 3 раза быстрее, чем к БД.dbf
FClose( nHandle ) // Закрытие базы данных #################
******* Повторное открытие базы и запись в нее ********
nHandle := FOpen( DB_name, FO_READWRITE ) // Открытие базы данных #################
*** Запись поля в БД (корректная) *********************
FOR i=1 TO N_Rec
FOR j=1 TO N_Col
IF aStructure[j,4] = 0
String = STR(999,aStructure[j,3])
ELSE
String = STR(999.99,aStructure[j,3],aStructure[j,4])
ENDIF
Flag_err = LC_FieldPut( DB_name, nHandle, i, j, String ) // Запись поля в БД (корректная) #####################
IF Flag_err
EXIT
ENDIF
NEXT
NEXT
RETURN NIL
***********************************************************
******** Создание Max_БД
******** - DB_name - имя создаваемой БД
******** - nHandle - идентификатор создаваемой БД
******** - aStructure - структура создаваемой БД
******** - N_Rec - количество строк (записей)
***********************************************************
FUNCTION LC_DbCreate( DB_name, nHandle, Lc_buf, N_Rec )
Len_LcBuf = LEN(Lc_buf)
nTimeON := SECONDS()
nMax = N_Rec
Mess = 'Создание файла: '+DB_name
@ 4,5 DCPROGRESS oProgr SIZE 80,1.1 MAXCOUNT nMax COLOR GRA_CLR_CYAN PERCENT EVERY 100
DCREAD GUI TITLE Mess PARENT @oDial FIT EXIT
oDial:show()
nTime = 0
DC_GetProgress(oProgr,0,nMax)
FOR i=1 TO N_Rec // Реальное число записей
Len_rec = FWrite( nHandle, Lc_buf, Len_LcBuf )
IF Len_rec < Len_LcBuf
MsgBox("Произошла ошибка записи файла: "+DB_name+". Ошибка:"+FERROR())
RETURN NIL
ENDIF
DC_GetProgress(oProgr, ++nTime, nMax)
NEXT
DC_GetProgress(oProgr,nMax,nMax)
*FClose( nHandle )
nTimeOFF := SECONDS()
*MsgBox("Время исполнения="+ALLTRIM(STR(nTimeOFF-nTimeON))+" сек.")
oDial:Destroy()
RETURN NIL
********************************************
******** Запись поля в Max_БД
********************************************
FUNCTION LC_FieldPut( DB_name, nHandle, mRec, mCol, String )
Pos = (mRec-1) * Len_LcBuf + aPos[mCol] - 1
FSEEK(nHandle, Pos, FS_SET) // Позиционирование начала поля
Len_str = LEN(String)
N_Write = FWrite( nHandle, String, Len_str )
IF N_Write < Len_str
Mess = 'Ошибка записи поля: [строка=@, колонка=$] в БД: "#"'
Mess = STRTRAN(Mess, "#", DB_Name)
Mess = STRTRAN(Mess, "@", ALLTRIM(STR(mRec)))
Mess = STRTRAN(Mess, "$", ALLTRIM(STR(mCol)))
MsgBox(Mess)
RETURN(.T.)
ENDIF
RETURN(.F.)
********************************************
******** Считывание поля из Max_БД
********************************************
FUNCTION LC_FieldGet( DB_name, nHandle, mRec, mCol )
Len_str = aStructure[mCol,3]
Pos = (mRec-1) * Len_LcBuf + aPos[mCol] - 1
FSEEK(nHandle, Pos, FS_SET) // Позиционирование начала поля
String = SPACE(Len_str)
N_Read = FRead( nHandle, @String, Len_str )
IF N_Read < Len_str
Mess = 'Ошибка считывания поля: [строка=@, колонка=$] БД: "#"'
Mess = STRTRAN(Mess, "#", DB_Name)
Mess = STRTRAN(Mess, "@", ALLTRIM(STR(mRec)))
Mess = STRTRAN(Mess, "$", ALLTRIM(STR(mCol)))
MsgBox(Mess)
RETURN("")
ENDIF
// Пробел в числовом поле рассматривается как "0"
IF aStructure[mCol,2] = "N" .AND. LEN(ALLTRIM(String)) = 0
String = "0"
ENDIF
RETURN(String)
* LC_AppendBl( DB_name, aStructure )
* LC_DeleteBl( DB_name )
******** Display a warning message
******** Может выдавать сообщения элементами массива и без ctitle:
*message := {}
*AADD(message,'1-е сообщение')
*AADD(message,'2-е сообщение')
*AADD(message,'3-е сообщение')
*LB_Warning( message )
FUNCTION LB_Warning( message, ctitle )
LOCAL aMsg := {}
DEFAULT cTitle TO ''
IF valtype(message) # 'A'
aadd(aMsg,message)
ELSE
aMsg := message
ENDIF
IF LEN(ALLTRIM(cTitle)) > 0
DC_MsgBox( ,,aMsg,cTitle)
ELSE
DC_MsgBox( ,,aMsg,'Универсальная когнитивная аналитическая система "Эйдос-Х++"')
ENDIF
RETURN NIL