/
YakuninAV
/
Convertors
Обзор
Документация
Войти
/
YakuninAV
/
Convertors
Код
Запросы
0
Задачи
Вики
Пакеты
0
Релизы
0
Аналитика
Безопасность
master
Core/DBDIntfs.pas
1 029 строк
52 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:21
1dc0fc6
Код
Авторство
О чём код?
unit DBDIntfs; {$I mormot.defines.inc} interface uses {$IFDEF ISDELPHIXE2} System.SysUtils, System.Classes, Vcl.StdCtrls, {$ELSE} SysUtils, Classes, Controls, {$ENDIF} mormot.core.base, mormot.core.os, mormot.core.unicode, mormot.core.json, mormot.core.variants , DBDCommons ; type /// Интерфейс архиватора IDBDArchiverV1 = interface /// Функция возвращает список файлов в архиве function GetFiles: TFileNameDynArray; /// Функция возвращает имя архивного файла function GetZipName: TFileName; /// Процедура устанавливает значение имени архивного файла procedure SetZipName(AValue: TFileName); /// Список файлов в архиве property Files: TFileNameDynArray read GetFiles; /// Имя архивного файла property ZipName: TFileName read GetZipName write SetZipName; /// Функция добавляет файл в архив function AddFile(const FileName: TFileName): Boolean; /// Функция добавляет файлы в архив function AddFiles(const aFiles: array of TFileName): Boolean; /// Функция добавляет в архив файлы из папки function AddFolder(const FolderName: TFileName; const Mask: string='*'; const Recursive: Boolean=false): Boolean; /// Функция распаковывает файл из архива на диск function ExtractFile(const FileName: TFileName; const DstFolder: TFileName=''; const DstFileName: TFileName=''): boolean; /// Функция удаляет файл из архива function RemoveFile(const FileName: TFileName): Boolean; /// Функция заменяет файл в архиве function UpdateFile(const FileName: TFileName): Boolean; /// Функция проверяет наличие файла в архиве function ExistsFileItem(const FileName: TFileName): Boolean; end; { TDBDArchiverBase } /// Абстрактный класс для реализации архиватора TDBDArchiverBase = class(TInterfacedObject, IDBDArchiverV1) private function GetZipName: TFileName; procedure SetZipName(AValue: TFileName); protected FZipName: TFileName; function GetFiles: TFileNameDynArray; virtual; abstract; public /// Список файлов в архиве property Files: TFileNameDynArray read GetFiles; /// Имя архивного файла property ZipName: TFileName read GetZipName write SetZipName; /// Конструктор распределяет память constructor Create(const FileName: TFileName); /// Деструктор освобождает распределённую память destructor Destroy; override; /// Функция добавляет файл в архив function AddFile(const FileName: TFileName): Boolean; virtual; abstract; /// Функция добавляет файлы в архив function AddFiles(const aFiles: array of TFileName): Boolean; virtual; abstract; /// Функция добавляет в архив файлы из папки function AddFolder(const FolderName: TFileName; const Mask: string='*'; const Recursive: Boolean=false): Boolean; virtual; abstract; /// Функция распаковывает файл из архива на диск function ExtractFile(const FileName: TFileName; const DstFolder: TFileName=''; const DstFileName: TFileName=''): Boolean; virtual; abstract; /// Функция удаляет файл из архива function RemoveFile(const FileName: TFileName): Boolean; virtual; abstract; /// Функция заменяет файл в архиве function UpdateFile(const FileName: TFileName): Boolean; virtual; abstract; /// Функция проверяет наличие файла в архиве function ExistsFileItem(const FileName: TFileName): Boolean; virtual; abstract; end; /// Тип сообщения // dmkDebugInfo - отладочная информация // dmkInformation - информация // dmkDbEvent - информация об операции с БД // dmkIteration - информация о текущей итерации // dmkDataInfo - передача информации // dmkWarning - предупреждение // dmkErrorInfo - ошибка // dmkCrashInfo - нехорошая ошибка TDBDMessageKind = (dmkDebugInfo, dmkInformation, dmkDbEvent, dmkIteration, dmkDataInfo, dmkWarning, dmkErrorInfo, dmkCrashInfo, dmkException); TDBDMessageKinds = set of TDBDMessageKind; /// Базовый обработчик события TDBDNotifyEvent = procedure (Sender: TObject; const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string; var Stop: Boolean) of object; /// Интерфейс для объектов, способных работать с JSON // Интерфейсы объектов для объектов способных загружать/выгружать информацию из/в JSON-документ, должны // наследоваться от этого интерфейса IDBDObjectV1= interface ['{3577E4E8-D1D8-4085-8232-EAB1595EF97D}'] /// Сообщение об возникших ошибках function Error: RawUtf8; /// Процедура осуществляет проверку объекта procedure Validate; /// функция загружает информацию из JSON-документа и, в случае успеха, возвращает true //! PDoc - указатель на JSON-докумет function FromDoc(const PDoc: PDocVariantData): Boolean; /// функция загружает информацию из JSON-строки function FromJson(const JSON: RawUtf8): Integer; /// функция загружает информацию из XML-строки function FromXML(const XML: RawUtf8): Integer; /// Функция возвращает JSON-документ с выгружанной в него информацией // function ToDoc: Variant; overload; deprecated; function ToDoc: Variant; overload; /// сериализует объект в XML-строку function ToXml(const TagName: RawUtf8=''): RawUtf8; overload; /// Функция формирует строку XML и возвращает 0 в случае успеха function ToXML(const TagName: RawUtf8; out XML: RawUtf8): Integer; overload; end; TDBDObjectV1DynArray = array of IDBDObjectV1; IDBDObjectListV1 = interface ['{A6099235-BCD5-4108-9281-D2172FFF0CB2}'] // геттеры function GetItem(const Index: Integer): IDBDObjectV1; function GetItems: TDBDObjectV1DynArray; // сеттеры procedure SetItem(const Index: Integer; AValue: IDBDObjectV1); // методы function AddItem(AValue: IDBDObjectV1): Integer; procedure Clear; function Count: Integer; function ToDoc: IDocList; /// сериализует объект в XML-строку function ToXml(const TagName: RawUtf8=''): RawUtf8; overload; /// Функция формирует строку XML и возвращает 0 в случае успеха function ToXML(const TagName: RawUtf8; out XML: RawUtf8): Integer; overload; // свойства property Item[const Index: Integer]: IDBDObjectV1 read GetItem write SetItem; property Items: TDBDObjectV1DynArray read GetItems; end; /// Интерфейс обработчика событий нотификатора IDBDNotifierV1 = interface ['{3BEB5A7E-6085-4AE9-9D66-47A0C5B89C41}'] /// Получить обработчик событий чтения/записи function GetOnLogNotify: TDBDNotifyEvent; /// Функция возвращает true, если предыдущее сообщение-итерация function GetPreviousIterMsg: boolean; /// Получить количество пропускаемых (ненотифицирумеых) итераций function GetSkipIterations: Word; /// Установить обработчик событий чтения/записи procedure SetOnLogNotify(const Value: TDBDNotifyEvent); /// Установить количество пропускаемых (ненотифицирумеых) итераций procedure SetSkipIterations(const Value: Word); /// Регистратор событий конвертации property OnLogNotify: TDBDNotifyEvent read GetOnLogNotify write SetOnLogNotify; /// Свойство уазывающее что предыдущее сообщение было итерацией property PreviousIterMsg: boolean read GetPreviousIterMsg; /// Количество пропускаемых (ненотифицирумеых) итераций property SkipIterations: Word read GetSkipIterations write SetSkipIterations; /// Проверить признак остановки процесса function GetStop: Boolean; /// Диспетчер сообщений о событиях чтения/записи function Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; overload; /// Диспетчер сообщений о событиях чтения/записи function Log(E: Exception): Boolean; overload; end; { TDBDNotifier } /// Класс реализующий базовые возможности IDBDNotifierV1 TDBDNotifier = class(TInterfacedObject, IDBDNotifierV1) strict private /// Обработчик событий событий чтения/записи FOnLogNotify: TDBDNotifyEvent; protected FStop: Boolean; FSkipIterations: Word; FPreviousIterMsg: Boolean; function GetOnLogNotify: TDBDNotifyEvent; function GetPreviousIterMsg: boolean; function GetSkipIterations: Word; procedure SetOnLogNotify(const Value: TDBDNotifyEvent); procedure SetSkipIterations(const Value: Word); public /// Регистратор событий конвертации property OnLogNotify: TDBDNotifyEvent read GetOnLogNotify write SetOnLogNotify; /// Свойство уазывающее что предыдущее сообщение было итерацией property PreviousIterMsg: boolean read GetPreviousIterMsg; /// Количество пропускаемых (ненотифицирумеых) итераций property SkipIterations: Word read GetSkipIterations write SetSkipIterations; /// Конструктор constructor Create(const NotifyEvent: TDBDNotifyEvent); /// Функция формирует строку из параметров сообщения class function FormatMsg(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): string; static; /// Функция переводит тип сообщения в строку class function MsgKindStr(const MsgKind: TDBDMessageKind): string; /// Функция определяет тип сообщения из строки class function MsgStrKind(const Msg: string): TDBDMessageKind; /// Функция проверяет входит ли вид сообщения в заданный class function CheckMsgKind(const Msg: string; const Kinds: TDBDMessageKinds=[dmkErrorInfo, dmkCrashInfo, dmkException]): Boolean; /// Проверить признак остановки процесса function GetStop: Boolean; /// Диспетчер сообщений о событиях чтения/записи function Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; overload; virtual; /// Диспетчер сообщений о событиях чтения/записи function Log(E: Exception): Boolean; overload; inline; end; /// Класс реализующий вывод сообщений в TStrings TDBDNotifierStr = class(TDBDNotifier) protected FStrings: TSTrings; public /// Конструктор constructor Create(Strings: TStrings; const NotifyEvent: TDBDNotifyEvent); /// Функция проверяет наличие сообщений входящих в заданый набор class function CheckMsgKinds(Strings: TStrings; const Kinds: TDBDMessageKinds=[dmkErrorInfo, dmkCrashInfo, dmkException]): Boolean; /// Диспетчер сообщений о событиях чтения/записи function Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; overload; override; end; /// Базовый класс для создания объектов поддерживающих работу с JSON- и XML-документами // Потомки этого класса должны использовать наследовать интерфейс IDBDObjectV1 или его потомков TDBDObjectV1 = class(TInterfacedObject, IDBDObjectV1) protected FData: IDocDict; FError: RawUtf8; public constructor Create(AData: IDocDict=nil); destructor Destroy; override; /// Сообщение об возникших ошибках function Error: RawUtf8; virtual; /// Процедура осуществляет проверку объекта procedure Validate; virtual; abstract; /// функция загружает информацию из JSON-документа и, в случае успеха, возвращает true //! PDoc - указатель на JSON-докумет function FromDoc(const PDoc: PDocVariantData): Boolean; virtual; /// функция загружает информацию из JSON-строки function FromJson(const JSON: RawUtf8): Integer; virtual; /// функция загружает информацию из XML-строки function FromXML(const XML: RawUtf8): Integer; virtual; /// Функция возвращает JSON-документ с выгружанной в него информацией // function ToDoc: Variant; overload; deprecated; function ToDoc: Variant; overload; virtual; /// сериализует объект в XML-строку function ToXml(const TagName: RawUtf8=''): RawUtf8; overload; virtual; /// Функция формирует строку XML и возвращает 0 в случае успеха function ToXML(const TagName: RawUtf8; out XML: RawUtf8): Integer; overload; virtual; end; /// Класс поддерживающий нотификатор, потомок TDBDObjectV1 // Потомки этого класса должны использовать наследовать интерфейс IDBDObjectV1 или его потомков TDBDNotifiedObjectV1 = class(TDBDObjectV1) protected FNotifier: IDBDNotifierV1; function Notify(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; overload; function Notify(const E: Exception): Boolean; overload; public constructor Create(Notifier: IDBDNotifierV1); destructor Destroy; override; end; TDBDObjectList = class(TInterfacedObject, IDBDObjectListV1) protected function GetItem(const Index: Integer): IDBDObjectV1; function GetItems: TDBDObjectV1DynArray; procedure SetItem(const Index: Integer; AValue: IDBDObjectV1); protected FList: TDBDObjectV1DynArray; FCount: Integer; FIncrement: Integer; public property Item[const Index: Integer]: IDBDObjectV1 read GetItem write SetItem; property Items: TDBDObjectV1DynArray read GetItems; function AddItem(AValue: IDBDObjectV1): Integer; constructor Create(const AIncrement: Integer=10); destructor Destroy; override; procedure Clear; function Count: Integer; function ToDoc: IDocList; virtual; abstract; /// сериализует объект в XML-строку function ToXml(const TagName: RawUtf8=''): RawUtf8; overload; virtual; abstract; /// Функция формирует строку XML и возвращает 0 в случае успеха function ToXML(const TagName: RawUtf8; out XML: RawUtf8): Integer; overload; virtual; abstract; end; /// Интерфейс для формирвания XMLфайлов IDBDWriterXMLV1 = interface ['{CC3DBB61-FD44-4648-A16F-1063C7AE248A}'] // геттеры function GetText: RawUTF8; function GetError: string; function GetOptions: TDBDXMLWriterOptions; function GetNamespaceSchemaLocation: TFileName; function GetPricePrecision: Integer; function GetQuantityPrecision: Integer; function GetValuePrecision: Integer; // сеттеры procedure SetPricePrecision(const Value: Integer); procedure SetQuantityPrecision(const Value: Integer); procedure SetValuePrecision(const Value: Integer); procedure SetNamespaceSchemaLocation(const Value: TFileName); procedure SetOptions(const Value: TDBDXMLWriterOptions); // методы /// Функция добавляет в XML схему из файла function AddSchemaFromFile(const FN: TFileName; const FileNameOnly: Boolean=False): Boolean; /// Функция добавляет в XML схему из ресурса приложения function AddSchemaFromResource(const ResID: string; const SchemaName: string): Boolean; /// Функция формирует начало XML-текста function BeginXML(const RootName: RawUTF8; const SchemaLocation: RawUTF8=''; const Addition: RawUtf8=''): Boolean; /// Процедура выводит в текст завершающий таг (закрывающий таг корневого элемента procedure EndXML; /// Функция возвращает true, если XML-текст сформирован function IsClosed: Boolean; /// Функция возвращает true, если объект готов к работе (может принимать текст) function IsReady: Boolean; /// Функция проверяет сформированный XLM-текст на соответствие схеме function isValid(const SchemaFile: TFileName; const isResource: Boolean=True): Boolean; ///Процедура выводит в текст элемент являющийся булевым значением procedure WriteBoolean(const ElemName: string; const ElemValue: Boolean); ///Процедура выводит в текст элемент являющийся булевым значением procedure WriteBooleanU(const ElemName: RawUTF8; const ElemValue: Boolean); ///Процедура выводит в текст элемент являющийся символом procedure WriteChar(const ElemName: string; const ElemValue: AnsiChar); ///Процедура выводит в текст элемент являющийся символом procedure WriteCharU(const ElemName: RawUTF8; const ElemValue: AnsiChar); ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до заданного числа знаков procedure WriteCurrency(const ElemName: string; const ElemValue: Currency; const Prec: Integer=DBD_PRICE_PREC; const Scale: Integer=1); ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до заданного числа знаков procedure WriteCurrencyU(const ElemName: RawUTF8; const ElemValue: Currency; const Prec: Integer=DBD_PRICE_PREC; const Scale: Integer=1); ///Процедура выводит в текст элемент являющийся датой procedure WriteDate(const ElemName: string; const ElemValue: TDateTime); ///Процедура выводит в текст элемент являющийся датой procedure WriteDateU(const ElemName: RawUTF8; const ElemValue: TDateTime); ///Процедура выводит в текст элемент являющийся датой procedure WriteDateTime(const ElemName: string; const ElemValue: TDateTime); ///Процедура выводит в текст элемент являющийся датой procedure WriteDateTimeU(const ElemName: RawUTF8; const ElemValue: TDateTime); ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до заданного числа знаков procedure WriteDouble(const ElemName: string; const ElemValue: Double; const Prec: Integer=-1; const Scale: Integer=1); ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до заданного числа знаков procedure WriteDoubleU(const ElemName: RawUTF8; const ElemValue: Double; const Prec: Integer=-1; const Scale: Integer=1); ///Процедура выводит в текст элемент являющийся целым числом procedure WriteInteger(const ElemName: string; const ElemValue: Integer); ///Процедура выводит в текст элемент являющийся целым числом procedure WriteIntegerU(const ElemName: RawUTF8; const ElemValue: Integer); ///Процедура выводит в текст элемент являющийся процентным числом, округляя его до соответсвующего числа знаков procedure WritePercent(const ElemName: string; const ElemValue: Double); ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков procedure WritePrice(const ElemName: string; const ElemValue: Double; const Scale: Integer=1); ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков procedure WritePriceU(const ElemName: RawUTF8; const ElemValue: Double; const Scale: Integer=1); ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков procedure WriteQuantity(const ElemName: string; const ElemValue: Double); ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков procedure WriteQuantityU(const ElemName: RawUTF8; const ElemValue: Double); ///Процедура выводит в текст элемент являющийся текстом procedure WriteString(const ElemName, ElemValue: string; HtmlEscape: Boolean=True); ///Процедура выводит в текст элемент являющийся текстом procedure WriteStringU(const ElemName: RawUTF8; const ElemValue: string; HtmlEscape: Boolean=True); ///Процедура выводит в текст элемент являющийся текстом procedure WriteUTF8(const ElemName: string; const ElemValue: RawUTF8; HtmlEscape: Boolean=True); ///Процедура выводит в текст элемент являющийся текстом procedure WriteUTF8U(const ElemName, ElemValue: RawUTF8; HtmlEscape: Boolean=True); ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков procedure WriteValue(const ElemName: string; const ElemValue: Double); overload; ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков procedure WriteValueU(const ElemName: RawUTF8; const ElemValue: Double); overload; ///Процедура выводит в текст открывающий таг procedure WriteTagOpenU(const ElemName: RawUTF8; const OnNewLine: Boolean = true); ///Процедура выводит в текст открывающий таг со списком аттрибутов procedure WriteTagOpenExU(const ElemName: RawUTF8; const ElemAttrs: RawUTF8=''; const isEmpty: Boolean=false); ///Процедура выводит в текст закрывающий таг procedure WriteTagCloseU(const ElemName: RawUTF8; const OnSameLine: Boolean = False); /// Процедура выводит в текст перевод строки procedure WriteCR; // свойства /// Описание ошибки, возникшей при формировании текста property Error: string read GetError; /// Опции формирования XML-текста property Options: TDBDXMLWriterOptions read GetOptions write SetOptions; /// Файл содержащий схему property NamespaceSchemaLocation: TFileName read GetNamespaceSchemaLocation write SetNamespaceSchemaLocation; /// Точность округления вещественного числа представляющего значение типа "Price" property PricePrecision: Integer read GetPricePrecision write SetPricePrecision; /// Точность округления вещественного числа представляющего значение типа "Quantity" property QuantityPrecision: Integer read GetQuantityPrecision write SetQuantityPrecision; /// Точность округления вещественного числа представляющего значение типа "Value" property ValuePrecision: Integer read GetValuePrecision write SetValuePrecision; /// XML-текст property Text: RawUTF8 read GetText; end; /// Интерфейс чтения данных IDBDReaderV1 = interface ['{6A46FF9B-5832-4592-A780-786590E89E98}'] /// Получить код ошибки function GetErrCode: Integer; /// Получить интерфейс нотификатора function GetNotifier: IDBDNotifierV1; /// Установить нотификатор procedure SetNotifier(Value: IDBDNotifierV1); /// Код ошибки property ErrCode: Integer read GetErrCode; /// Нотификатор property Notifier: IDBDNotifierV1 read GetNotifier write SetNotifier; /// Прочитать содержимое файла в структуру Doc function Read(const FN: TFilename; out Doc: Variant): Boolean; overload; safecall; /// Прочитать содержимое файла в буфер function Read(const FN: TFilename; out P: Pointer; out Len: Integer): Boolean; overload; safecall; /// Прочитать содержимое файла в структуру Elem function Read(const FN: TFilename; out Elem): Boolean; overload; end; /// Интерфейс для чтения из файла транспортного пакета смет IDBDReaderV2 = interface ['{25F6258E-EBAE-4CB6-9585-FA03BE8F5BAC}'] //геттеры function GetOptions: Variant; //сеттеры procedure SetOptions(Value: Variant); //методы /// Функция возвращает текст ошибки function Error: string; /// function Read(out Doc: IInterface): Boolean; overload; /// function Read(out Doc: IDocAny): Boolean; overload; /// Опции и параметры чтения смет property Options: Variant read GetOptions write SetOptions; end; /// Интрерфейс чтения отчёта чтения файлов Excel IDBDExcelReaderV1 = interface ['{719C904C-93FD-44FA-92E9-3B5388378D63}'] /// Закрыть Excel-файл procedure Close; /// Взять значение из ячейки (тип Currency) function GetCellAsCurrency(const aRow, aCol: Integer): Currency; /// Взять значение из ячейки (тип Date) function GetCellAsDate(const aRow, aCol: Integer): TDate; /// Взять значение из ячейки (тип DateTime) function GetCellAsDateTime(const aRow, aCol: Integer): TDateTime; /// Взять значение из ячейки (тип Double) function GetCellAsFloat(const aRow, aCol: Integer): Double; /// Взять значение из ячейки (тип Integer) function GetCellAsInteger(const aRow, aCol: Integer): Integer; /// Взять значение из ячейки (тип String) function GetCellAsText(const aRow, aCol: Integer): string; /// Взять значение из ячейки (тип Time) function GetCellAsTime(const aRow, aCol: Integer): TTime; /// Взять значение из ячейки (тип RawUTF8) function GetCellAsUTF8(const aRow, aCol: Integer): RawUTF8; /// Взять значение из ячейки (тип Variant) function GetCellAsVariant(const aRow, aCol: Integer): Variant; /// Взять формулу из ячейки function GetCellFormula(const aRow, aCol: Integer): string; /// Получить количество листво в книге function GetCount: Integer; /// Получить индекс текущего листа function GetCurrWorkSheetIdx: Integer; /// Получить список листов в книге function GetOpenedWorksheetNames: string; /// Получить список названий открытых книг function GetOpenedWorkbookNames: string; /// Название текущего листа function GetWorkSheetName: string; /// Получить номер последней колонки текущего листа function LastCol: Integer; /// Получить номер последней строки текущего листа function LastRow: Integer; /// Перейти к следующему листу, если текущий лист последний возвращает false function NextWorkSheet: Boolean; /// Открыть Excel файл function OpenWorkBook(const aFileName: TFilename): Integer; /// Открыть (сделать текущим) лист по индексу. Функция возвращает имя листа или пусто function OpenWorkSheet(const aIndex: Integer): string; overload; /// Найти и открыть (сделать текущим) лист по названию. Функция возваращает индекс листа или <=0 function OpenWorkSheet(const aWorkSheetName: string): Integer; overload; /// Количество листов в книге property Count: Integer read GetCount; /// Индекс текущего листа property CurrWorkSheetIdx: Integer read GetCurrWorkSheetIdx; end; /// Интрерфейс записи информации в файлы Excel IDBDExelWriterV1 = interface ['{8F573342-713A-4D57-8A37-7789DAAE9B4C}'] /// Закрыть Excel-файл procedure Close; /// Получить количество листво в книге function GetCount: Integer; /// Получить индекс текущего листа function GetCurrWorkSheetIdx: Integer; /// Получить список листов в книге function GetOpenedWorksheetNames: string; /// Получить список названий открытых книг function GetOpenedWorkbookNames: string; /// Название текущего листа function GetWorkSheetName: string; /// Получить номер последней колонки текущего листа function LastCol: Integer; /// Получить номер последней строки текущего листа function LastRow: Integer; /// Перейти к следующему листу, если текущий лист последний возвращает false function NextWorkSheet: Boolean; /// Открыть Excel файл function OpenWorkBook(const aFileName: TFilename): Integer; /// Открыть (сделать текущим) лист по индексу. Функция возвращает имя листа или пусто function OpenWorkSheet(const aIndex: Integer): string; overload; /// Найти и открыть (сделать текущим) лист по названию. Функция возваращает индекс листа или <=0 function OpenWorkSheet(const aWorkSheetName: string): Integer; overload; /// Количество листов в книге property Count: Integer read GetCount; /// Индекс текущего листа property CurrWorkSheetIdx: Integer read GetCurrWorkSheetIdx; end; /// Интерфейс чтения таблиц из файлов Word IDBDWordReaderV1 = interface ['{7167FDFD-1F18-4F9D-BD77-6C8C5F0634DB}'] /// Закрыть документ Word procedure Close; /// Получить из текста название документа (используя стиль) function GetDocumentTitle: string; /// Функция извлекает из текста первый заголовок или возвращает false function GetFirstHeader(var Lvl: Integer; var BegPos: Integer; out S: string): Boolean; /// Функция извлекает из текста очередной заголовок или возвращает false function GetNextHeader(var Lvl: Integer; var BegPos: Integer; out S: string): Boolean; /// Открыть документ Word function OpenWordDocument(const aFileName: TFileName): Integer; /// Функция возвращает количетсво таблиц в документе function TablesCount: Integer; /// Функция возвращает содержимое таблицы function GetTable(const Index: Integer; out Table: Variant; out ID: string; out Name: string): Boolean; /// Функция возвращает идентификатор и наименование таблицы function GetTableName(const SeqNo: Integer; out ID: string; out Name: string): Boolean; /// Функция премещает указатель на таблицу, если не удалось, то возвращает false function GoToTable(const Index: integer; out ID: string; out Name: string; out tabPos: Integer): Boolean; /// Функция возвращает значение из ячейки текущей таблицы function GetCellAsText(const Row, Col: Integer; out Text: string): Boolean; // function GetCellAsText(const Row, Col: Integer): string; overload; /// Функция возвращает значение из ячейки текущей таблицы function GetCellAsUTF8(const Row, Col: Integer; out Text: RawUTF8): Boolean; overload; // function GetCellAsUTF8(const Row, Col: Integer): RawUTF8; overload; /// Количество строк в текущей таблице function RowsCount: Integer; /// Количество колонок в текущей таблице function ColsCount: Integer; end; /// Базовый класс для реализации интерфейса чтения файлов Excel TDBDBaseExcelReader = class abstract(TInterfacedObject, IDBDExcelReaderV1) {strict} protected FCurrIdx: Integer; FCount: Integer; FStop: Boolean; FNotifier: IDBDNotifierV1; FLastCol, FLastRow: Integer; const FUserCodePage: Word = 65001; function GetWorkSheetName: string; virtual; abstract; function GetCount: Integer; function GetCurrWorkSheetIdx: Integer; function Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; inline; function OpenFile(const aFileName: TFilename): integer; virtual; abstract; // Перевести адрес в формате (R1,C1) в формат (A1) (256 колонок) class function xlRCtoA1(const ARow, ACol: Integer; RowAbsolute: Boolean = False; ColAbsolute: Boolean = False): String; public constructor Create(const aNotifier: IDBDNotifierV1 = nil); /// Взять значение из ячейки (тип Currency) function GetCellAsCurrency(const aRow, aCol: Integer): Currency; virtual; abstract; /// Взять значение из ячейки (тип TDate) function GetCellAsDate(const aRow, aCol: Integer): TDate; virtual; abstract; /// Взять значение из ячейки (тип TDateTime) function GetCellAsDateTime(const aRow, aCol: Integer): TDateTime; virtual; abstract; /// Взять значение из ячейки (тип Double) function GetCellAsFloat(const aRow, aCol: Integer): Double; virtual; abstract; /// Взять значение из ячейки (тип Integer) function GetCellAsInteger(const aRow, aCol: Integer): Integer; virtual; abstract; /// Взять значение из ячейки (тип string) function GetCellAsText(const aRow, aCol: Integer): string; virtual; abstract; /// Взять значение из ячейки (тип TTime) function GetCellAsTime(const aRow, aCol: Integer): TTime; virtual; abstract; /// Взять значение из ячейки (тип RawUTF8) function GetCellAsUTF8(const aRow, aCol: Integer): RawUTF8; virtual; /// Взять значение из ячейки (тип Variant) function GetCellAsVariant(const aRow, aCol: Integer): Variant; virtual; abstract; /// Взять формулу из ячейки function GetCellFormula(const aRow, aCol: Integer): string; virtual; abstract; /// Список названий открытых книг function GetOpenedWorkbookNames: string; virtual; abstract; /// Получить список листов в книге function GetOpenedWorksheetNames: string; virtual; abstract; /// Получить номер последней колонки текущего листа function LastCol: Integer; virtual; abstract; /// Получить номер последней строки, содержащей информацию function LastRow: Integer; virtual; abstract; /// Открыть следующий лист function NextWorkSheet: Boolean; virtual; /// Открыть Excel файл function OpenWorkBook(const aFileName: TFilename): Integer; virtual; /// Открыть (сделать текущим) лист по индексу. Функция возвращает имя листа или пусто function OpenWorkSheet(const aIndex: Integer): string; overload; virtual; abstract; /// Найти и открыть (сделать текущим) лист по названию. Функция возваращает индекс листа или <=0 function OpenWorkSheet(const aWorkSheetName: string): Integer; overload; virtual; abstract; /// Закрыть Excel-файл procedure Close; virtual; abstract; /// Количество рабочих листов в книге property Count: Integer read GetCount; /// порядковый номер текущего листа property CurrWorkSheetIdx: Integer read GetCurrWorkSheetIdx; end; /// Базовый класс для реализации интерфейса чтения файлов Word TDBDBaseWordReader = class abstract(TInterfacedObject, IDBDWordReaderV1) strict protected FNotifier: IDBDNotifierV1; function Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; inline; public /// Закрыть документ Word procedure Close; virtual; abstract; /// Получить из текста название документа (используя стиль) function GetDocumentTitle: string; virtual; abstract; /// Функция извлекает из текста первый заголовок или возвращает false function GetFirstHeader(var Lvl: Integer; var BegPos: Integer; out S: string): Boolean; virtual; abstract; /// Функция извлекает из текста очередной заголовок или возвращает false function GetNextHeader(var Lvl: Integer; var BegPos: Integer; out S: string): Boolean; virtual; abstract; /// Функция возвращает количетсво таблиц в документе function TablesCount: Integer; virtual; abstract; /// Открыть документ Word function OpenWordDocument(const aFileName: TFileName): Integer; virtual; abstract; /// Функция возвращает содержимое таблицы function GetTable(const Index: Integer; out Table: Variant; out ID: string; out Name: string): Boolean; virtual; abstract; /// Функция возвращает идентификатор и наименование таблицы function GetTableName(const SeqNo: Integer; out ID: string; out Name: string): Boolean; virtual; abstract; /// Функция премещает указатель на таблицу, если не удалось, то возвращает false function GoToTable(const Index: integer; out ID: string; out Name: string; out tabPos: Integer): Boolean; virtual; abstract; /// Функция возвращает значение из ячейки текущей таблицы function GetCellAsText(const Row, Col: Integer; out Text: string): Boolean; virtual; abstract; /// Функция возвращает значение из ячейки текущей таблицы function GetCellAsUTF8(const Row, Col: Integer; out Text: RawUTF8): Boolean; overload; virtual; abstract; // function GetCellAsUTF8(const Row, Col: Integer): RawUTF8; overload; virtual; abstract; /// Количество строк в текущей таблице function RowsCount: Integer; virtual; abstract; /// Количество колонок в текущей таблице function ColsCount: Integer; virtual; abstract; /// Конструктор constructor Create(const aNotifier: IDBDNotifierV1 = nil); end; var DBDWordTabCellTrim: Boolean = True; implementation { TDBDArchiverBase } constructor TDBDArchiverBase.Create(const FileName: TFileName); begin inherited Create; FZipName:=FileName; end; destructor TDBDArchiverBase.Destroy; begin inherited Destroy; end; function TDBDArchiverBase.GetZipName: TFileName; begin Result:=FZipName; end; procedure TDBDArchiverBase.SetZipName(AValue: TFileName); begin FZipName:=AValue; end; { TDBDBaseExcelReader } constructor TDBDBaseExcelReader.Create(const aNotifier: IDBDNotifierV1); begin inherited Create; FNotifier := aNotifier; FCurrIdx := 0; FCount := 0; FLastRow:=0; FLastCol:=0; end; function TDBDBaseExcelReader.GetCellAsUTF8(const aRow, aCol: Integer): RawUTF8; var s: string; begin s := GetCellAsText(aRow,aCol); Result := StringToUTF8(s); end; function TDBDBaseExcelReader.GetCount: Integer; begin result := FCount; end; function TDBDBaseExcelReader.GetCurrWorkSheetIdx: Integer; begin result := FCurrIdx; end; function TDBDBaseExcelReader.Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; begin if Assigned(FNotifier) then Result := FNotifier.Log(MsgKind, MsgCode, MsgText) else Result := True; end; function TDBDBaseExcelReader.NextWorkSheet: Boolean; begin result := FCurrIdx < FCount-1; if result then Inc(FCurrIdx); end; function TDBDBaseExcelReader.OpenWorkBook(const aFileName: TFilename): Integer; begin Assert(aFileName<>'','Имя файла не может быть пустым'); Assert(FileExists(aFileName),'Файл не найден'); if aFileName='' then Result := -1 else if FileExists(aFileName) then Result := 0 else result := -2; end; class function TDBDBaseExcelReader.xlRCtoA1(const ARow, ACol: Integer; RowAbsolute, ColAbsolute: Boolean): String; const A1 = Ord('A') - 1; // номер "A" минус 1 (65 - 1 = 64) AZ = Ord('Z') - A1; // кол-во букв в англ. алфавите (90 - 64 = 26) var t, m: Integer; // S: String[9]; // чтоб экономить память IV=256 последний столбец S: string; begin // номер колонки t := ACol div AZ; // целая часть m := (ACol mod AZ); // остаток? if m = 0 then Dec(t); if t > 0 then S := Char(A1 + t) else S := ''; if m = 0 then t := AZ else t := m; S := S + Char(A1 + t); // весь адрес if ColAbsolute then S := '$' + S; if RowAbsolute then S := S + '$'; S := S + IntToStr(ARow); Result := S; end; { TDBDNotifier } class function TDBDNotifier.CheckMsgKind(const Msg: string; const Kinds: TDBDMessageKinds): Boolean; var k: TDBDMessageKind; begin if (Length(Msg)<5) or (Kinds=[]) then Result:=True else begin k:=MsgStrKind(Msg); Result:=k in Kinds; end; end; constructor TDBDNotifier.Create(const NotifyEvent: TDBDNotifyEvent); begin FOnLogNotify := NotifyEvent; FStop := False; end; class function TDBDNotifier.FormatMsg(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): string; begin Result:=Format('%s|%6.6d|%s',[MsgKindStr(MsgKind),MsgCode,MsgText]); end; function TDBDNotifier.GetOnLogNotify: TDBDNotifyEvent; begin Result := FOnLogNotify; end; function TDBDNotifier.GetPreviousIterMsg: boolean; begin Result:=FPreviousIterMsg; end; function TDBDNotifier.GetSkipIterations: Word; begin Result:=FSkipIterations; end; function TDBDNotifier.GetStop: Boolean; begin Result := FStop; end; function TDBDNotifier.Log(E: Exception): Boolean; begin if Assigned(E) then Result:=Log(dmkException, E.HelpContext, E.Message) else Result:=Log(dmkCrashInfo, 0, 'Неопознанное исключение'); end; function TDBDNotifier.Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; begin if Assigned(FOnLogNotify) then try FOnLogNotify(Self, MsgKind, MsgCode, MsgText, FStop); except FStop := True; end; Result := FStop; FPreviousIterMsg:=(MsgKind=dmkIteration); end; class function TDBDNotifier.MsgKindStr(const MsgKind: TDBDMessageKind): string; begin case MsgKind of dmkDebugInfo: Result:='DEBUG'; dmkInformation: Result:='INFO '; dmkDbEvent: Result:='DATA '; dmkIteration: Result:='ITER '; dmkWarning: Result:='WARN '; dmkErrorInfo: Result:='ERROR'; dmkCrashInfo: Result:='CRASH'; dmkException: Result:='EXCPT'; end; end; class function TDBDNotifier.MsgStrKind(const Msg: string): TDBDMessageKind; var s: string; begin if Length(Msg)>5 then s:=Copy(Msg,1,5); if s='DEBUG' then Result := dmkDebugInfo else if s='DEBUG' then Result := dmkDebugInfo else if s='INFO ' then Result := dmkInformation else if s='DATA ' then Result := dmkDataInfo else if s='ITER ' then Result := dmkIteration else if s='WARN ' then Result := dmkWarning else if s='ERROR' then Result := dmkErrorInfo else if s='CRASH' then Result := dmkCrashInfo else if s='EXCPT' then Result := dmkException else Result := dmkCrashInfo; end; procedure TDBDNotifier.SetOnLogNotify(const Value: TDBDNotifyEvent); begin FOnLogNotify := Value; end; procedure TDBDNotifier.SetSkipIterations(const Value: Word); begin FSkipIterations:=Value; end; { TDBDBaseWordReader } constructor TDBDBaseWordReader.Create(const aNotifier: IDBDNotifierV1); begin inherited Create; FNotifier := aNotifier; end; function TDBDBaseWordReader.Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; begin if Assigned(FNotifier) then Result := FNotifier.Log(MsgKind, MsgCode, MsgText) else Result := True; end; { TDBDNotifierStr } class function TDBDNotifierStr.CheckMsgKinds(Strings: TStrings; const Kinds: TDBDMessageKinds): Boolean; var s: string; begin Result:=False; if (Strings<>nil) or (Strings.Count<1) then Exit; for s in Strings do if TDBDNotifier.CheckMsgKind(s, Kinds) then begin Result:=True; Exit; end; end; constructor TDBDNotifierStr.Create(Strings: TStrings; const NotifyEvent: TDBDNotifyEvent); begin inherited Create(NotifyEvent); FStrings:=Strings; end; function TDBDNotifierStr.Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; begin if Assigned(FStrings) then begin FStrings.Add(FormatMsg(MsgKind, MsgCode, MsgText)); end; Result := FStop; FPreviousIterMsg:=(MsgKind=dmkIteration); end; { TDBDNotifiedObjectV1 } constructor TDBDNotifiedObjectV1.Create(Notifier: IDBDNotifierV1); begin inherited Create(nil); FNotifier:=Notifier; end; destructor TDBDNotifiedObjectV1.Destroy; begin FNotifier:=nil; inherited; end; function TDBDNotifiedObjectV1.Notify(const E: Exception): Boolean; begin if FNotifier<>nil then Result:=FNotifier.Log(dmkException, E.HelpContext, E.Message); FError:= FError+'; '+ E.Message; end; function TDBDNotifiedObjectV1.Notify(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; begin if FNotifier<>nil then Result:=FNotifier.Log(MsgKind, MsgCode, MsgText); if MsgKind in [dmkException, dmkErrorInfo] then FError:= FError+'; '+ MsgText; end; { TDBDObjectList } function TDBDObjectList.AddItem(AValue: IDBDObjectV1): Integer; begin if AValue=nil then Result:=-1 else begin if Length(FList)=FCount then SetLength(FList, FCount+FIncrement); FList[FCount]:=AValue; Inc(FCount); end; end; procedure TDBDObjectList.Clear; var i: Integer; begin SetLength(FList,FIncrement); FCount:=0; for i:=0 to Length(FList)-1 do FList:=nil; end; function TDBDObjectList.Count: Integer; begin Result:=FCount; end; constructor TDBDObjectList.Create(const AIncrement: Integer); begin inherited Create; if AIncrement>0 then FIncrement:=AIncrement else FIncrement:=10; end; destructor TDBDObjectList.Destroy; begin SetLength(FList,0); inherited; end; function TDBDObjectList.GetItem(const Index: Integer): IDBDObjectV1; begin if (Index>=0) and (Index<FCount) then Result:=FList[Index] else Result:=nil; end; function TDBDObjectList.GetItems: TDBDObjectV1DynArray; var i,l: Integer; begin SetLength(FList, FCount); l:=0; for I := 0 to FCount-1 do begin if Result[i]<>nil then Result[i] := FList[l]; Inc(l); end; if l<FCount then begin SetLength(Result,l); FCount:=l; FList:=Result; end; end; procedure TDBDObjectList.SetItem(const Index: Integer; AValue: IDBDObjectV1); begin if (Index>=0) and (Index<FCount) then FList[Index]:=AValue; end; { TDBDObjectV1 } constructor TDBDObjectV1.Create(AData: IDocDict); begin inherited Create; if AData=nil then FData:=DocDict() else FData:=AData; FError:=''; end; destructor TDBDObjectV1.Destroy; begin if FData<>nil then FData:=nil; FError:=''; inherited; end; function TDBDObjectV1.Error: RawUtf8; begin Result:=FError; end; function TDBDObjectV1.FromDoc(const PDoc: PDocVariantData): Boolean; begin end; function TDBDObjectV1.FromJson(const JSON: RawUtf8): Integer; begin end; function TDBDObjectV1.FromXML(const XML: RawUtf8): Integer; begin end; function TDBDObjectV1.ToDoc: Variant; begin end; function TDBDObjectV1.ToXml(const TagName: RawUtf8; out XML: RawUtf8): Integer; begin end; function TDBDObjectV1.ToXml(const TagName: RawUtf8): RawUtf8; begin end; end.