Core/DBDExcelBaseClassess.pas - master - YakuninAV/Convertors

Core/DBDExcelBaseClassess.pas
461 строка21 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit DBDExcelBaseClassess;

{$I mormot.defines.inc}

interface

uses
  SysUtils, StrUtils, Classes, Types, Windows,// Excel2000,
  mormot.core.base, mormot.core.os, mormot.core.variants, mormot.core.json, mormot.core.unicode,
  DBDIntfs, DBDExcelInfs
//  , DBDUtf8Utils
  , DBDStrUtils
  ;

const
  DBDExcelMaxLengthFileName = 200;

type

  /// Базовый класс для работы с Excel
  TDBDExcelBase = class(TInterfacedObject, IDBDExcelV2)
  private
    function GetCountWB: Integer;
    function GetCountWS: Integer;
    function GetCurrentWSIndex: Integer;
  protected
    FCountWB: Integer;
    FCountWS: Integer;
    FCurrIdx: Integer;
    FLastCol: Integer;
    FLastRow: Integer;
    FFileName: TFileName;    // оригинальное им файла
    FCopyName: TFileName;    // имя файла-копии
    FNameWS: string;
    FNotifier: IDBDNotifierV1;
    FOptions: TDBDOpenWBOprions;
    FTable: TDBDTable;
    rdr: IDBDExcelReaderV2;
    wrt: IDBDExcelWriterV2;
    function GetCurrWSName: string; virtual; abstract;
    function GetOptions: TDBDOpenWBOprions;
    function GetReader: IDBDExcelReaderV2; virtual;
    function GetWriter: IDBDExcelWriterV2; virtual;
    procedure SetCurrWSName(const Value: string); virtual; abstract;
    procedure SetOptions(Const Value: TDBDOpenWBOprions);
    function Log(const MsgKind: TDBDMessageKind; const MsgCode: Integer; const MsgText: string): Boolean; inline;
    function CheckEnumRow(const LastRow: Integer=-1; const LeftCol: Integer=1; const RightCol: Integer=0;
                          const SkipEmpty: Boolean=true): TDBDTable; virtual; abstract;
    function GetCellHeight(const Row, Col: Integer): Integer; virtual; abstract;
    function GetCellWidth(const Row, Col: Integer): integer; virtual; abstract;
    function GetColumnWidth(const Col: Integer): integer; virtual; abstract;
    function GetRowHeight(const Row: Integer): Integer; virtual; abstract;
  public
    /// Количество открытых книг
    property CountWB: Integer read GetCountWB;
    /// Количество листов в книге
    property CountWS: Integer read GetCountWS;
    /// Индекс текущего листа
    property CurrWorkSheetIdx: Integer read GetCurrentWSIndex;
    /// Наименование текущего листа книги
    property CurrWSName: string read GetCurrWSName write SetCurrWSName;
    ///
    property Options: TDBDOpenWBOprions read GetOptions write SetOptions;
    /// Интерфейс чтения данных из ячеек
    property Reader: IDBDExcelReaderV2 read GetReader;
    /// Интерфейс записи данных в ячейки
    property Writer: IDBDExcelWriterV2 read GetWriter;
    /// констркутор
    constructor Create(const WBOptions: TDBDOpenWBOprions = []; const aNotifier: IDBDNotifierV1 = nil); overload;
    /// констркутор
    constructor Create(tblDescr: TDBDTable; const WBOptions: TDBDOpenWBOprions = []; const aNotifier: IDBDNotifierV1 = nil); overload;
    /// Деструктор
    destructor Destroy; override;
    /// Добавить пустой лист в книгу
    function AddWorkSheet(const aName: string; const Index: Word=0): Integer; virtual; abstract;
    /// Закрыть Excel-файл
    procedure Close; virtual; abstract;
    /// Функция копирует область
    //  Src, Dst - строки представляющие адреса источника и назначения
    function CopyRange(const Src, Dst: string): Boolean; overload; virtual; abstract;
    /// Функция копирует область, заданную с помощью SrcRng, с листа Src на Лист Dst, начиная с ячейки DstCell
    function CopyRange(const Src: string; const SrcRng: TRect; const Dst: string; const DstCell: TPoint): Boolean; overload; virtual; abstract;
    /// Функция копирует область, заданную с помощью SrcRng, с листа Src на Лист Dst, начиная с ячейки (Row,Col)
    function CopyRange(const Src,SrcRng,Dst: string; const Row, Col: Word): Boolean; overload; virtual; abstract;
    /// Создать копию листа
    function CopyWorkSheet(const Src, Dst: string): Boolean; overload; virtual; abstract;
    /// Создать копию листа
    function CopyWorkSheet(SrcIdx: Word; const Dst: string): Boolean; overload; virtual; abstract;
    /// Получить список листов в книге
    function GetOpenedWorksheetNames: string; virtual; abstract;
    /// Получить список названий открытых книг
    function GetOpenedWorkbookNames: string; virtual; abstract;
    /// Полчить индекс листа с заданныи именем
    function GetWorkSheetIdx(const aWorkSheetName: string): Integer; virtual; abstract;
    /// Название текущего листа
    function GetWorkSheetName: string; virtual;
    /// Функция вставляет строку в указанное место
    //  если флаг DoCopy установлен, то содержимое текущей строки копируется в новую
    function InsertRow(const aRow: Word; const DoCopy: Boolean=True): Boolean; virtual; abstract;
    /// Получить номер последней колонки текущего листа
    function LastCol: Integer; virtual;
    /// Получить номер последней строки текущего листа
    function LastRow: Integer; virtual;
    /// Открыть пустой Excel файл
    function NewWorkBook(const aFileName: TFilename; const WBOptions: TDBDOpenWBOprions = []): Integer; virtual; abstract;
    /// Перейти к следующему листу, если текущий лист последний возвращает false
    function NextWorkSheet: Boolean; virtual; abstract;
    /// Открыть Excel файл
    function OpenWorkBook(const aFileName: TFilename; const WBOptions: TDBDOpenWBOprions = []): Integer; virtual; abstract;
    /// Открыть (сделать текущим) лист по индексу. Функция возвращает имя листа или пусто
    function OpenWorkSheet(const aIndex: Integer): string; overload; virtual; abstract;
    /// Найти и открыть (сделать текущим) лист по названию. Функция возваращает индекс листа или <=0
    function OpenWorkSheet(const aWorkSheetName: string): Integer; overload; virtual; abstract;
    /// Функция производит выравнивание содержимого ячейки
    // если aRow=0, то выравнивание производится для всех ячеек столбца
    // если aCol=0, то выравнивание производится для всех ячеек строки
    function RangeAlign(const aRow, aCol: Word; const VAligment: Integer = xlVAlignTop;
                        const HAligment: Integer = xlHAlignGeneral): Boolean; overload; virtual; abstract;
    /// Функция производит выравнивание содержимого ячеек заданного региона
    function RangeAlign(const aRange: TRect; const VAligment: Integer = xlVAlignTop;
                        const HAligment: Integer = xlHAlignGeneral): Boolean; overload; virtual; abstract;
    /// Функция рисует границы области
    //  Borders - число, установленные биты которого указываю стороны ячейки
    function RangeBorders(const aRange: string;const Borders: Byte;
                          const LineStyle: Integer = xlContinuous; const LineWeight: Integer = xlThin): Boolean; virtual; abstract;
    /// Функция закрашивает фон области в заданный цвет
    function RangeColor(const aRow, aCol: Word; const rangeRGB: Cardinal): Boolean; virtual; abstract;
    /// Функция переводит название региона в его координаты (Top, Left, Rows, Cols);
    function Range2Rect(const aRange: string; out Rect: TRect): Boolean; virtual; abstract;
  end;

  TDBDExcelReaderBase = class(TInterfacedObject, IDBDExcelReaderV2)
  protected
    FOwner: IDBDExcelV2;
    FWSName: string;
    const FUserCodePage: Word = 65001;
    function GetWSName: string;
  public
    function AsBoolean(const aRow, aCol: Word; out B: Boolean): Boolean; overload; virtual; abstract;
    function AsBoolean(const aRow, aCol: Word): Boolean; overload;
    function AsCurrency(const aRow, aCol: Word; out C: Currency): Boolean; overload; virtual; abstract;
    function AsCurrency(const aRow, aCol: Word): Currency; overload;
    function AsDateTime(const aRow, aCol: Word; out D: TDateTime): Boolean; overload; virtual; abstract;
    function AsDateTime(const aRow, aCol: Word): TDateTime; overload;
    function AsDouble(const aRow, aCol: Word; out D: Double): Boolean; overload; virtual; abstract;
    function AsDouble(const aRow, aCol: Word): Double; overload;
    function AsExtended(const aRow, aCol: Word; out D: Extended): Boolean; overload; virtual; abstract;
    function AsExtended(const aRow, aCol: Word): Extended; overload;
    function AsInteger(const aRow, aCol: Word; out I: Integer): Boolean; overload; virtual; abstract;
    function AsInteger(const aRow, aCol: Word): Integer; overload;
    function AsInt64(const aRow, aCol: Word; out I: Int64): Boolean; overload; virtual; abstract;
    function AsInt64(const aRow, aCol: Word): Int64; overload;
    function AsString(const aRow, aCol: Word; out S: String): Boolean; overload; virtual; abstract;
    function AsString(const aRow, aCol: Word): string; overload;
    function AsVariant(const aRow, aCol: Word; out V: Variant): Boolean; overload; virtual; abstract;
    function AsVariant(const aRow, aCol: Word): Variant; overload;
    constructor Create(Owner: IDBDExcelV2);
    destructor Destroy; override;
  end;

  TDBDExcelWriterBase = class(TInterfacedObject,IDBDExcelWriterV2)
  protected
    FOwner: IDBDExcelV2;
    FWSName: string;
    function GetWSName: string;
  public
    /// Функция рисует границы ячейки
    function CellBorders(const aRow, aCol: Word; const Borders: Byte;
                         const LineStyle: Integer = xlContinuous; const LineWeight: Integer = xlThin): boolean; virtual; abstract;
    function InsertRow(const aRow: Word; const DoCopy: Boolean=True): Boolean; virtual; abstract;
    /// Объединить ячейки, заданные координатами (Top, Left, Rows, Cols)
    function MergeCells(const aRange: TRect): Boolean; virtual; abstract;
    /// Функция производит выравнивание содержимого ячейки
    // если aRow=0, то выравнивание производится для всех ячеек столбца
    // если aCol=0, то выравнивание производится для всех ячеек строки
    function RangeAlign(const aRow, aCol: Word; const VAligment, HAligment: Integer): Boolean; overload; virtual; abstract; deprecated;
    function RangeAlign(const aRow, aCol: Word; const VAlignment: TDBDVertAlignment=dbdvaDefault;
                        const HAligment: TDBDHorAlignment=dbdhaDefault): Boolean; overload; virtual; abstract;
    /// Функция производит выравнивание содержимого ячеек заданного региона
    function RangeAlign(const aRange: TRect; const VAligment: Integer = xlVAlignTop; const HAligment: Integer = xlHAlignGeneral): Boolean; overload;  virtual; abstract;
    /// Функция вставляет строку в указанное место
    //  если флаг DoCopy установлен, то содержимое текущей строки копируется в новую
    function WriteBoolean(const aCell: string; const B: Boolean): Boolean; overload; virtual; abstract;
    function WriteBoolean(const aRow, aCol: Word; const B: Boolean): Boolean; overload; virtual; abstract;
    function WriteCurrency(const aCell: string; const C: Currency): Boolean; overload; virtual; abstract;
    function WriteCurrency(const aRow, aCol: Word; const C: Currency): Boolean; overload; virtual; abstract;
    function WriteDateTime(const aCell: string; const D: TDateTime): Boolean; overload; virtual; abstract;
    function WriteDateTime(const aRow, aCol: Word; const D: TDateTime): Boolean; overload; virtual; abstract;
    function WriteDouble(const aCell: string; const D: Double): Boolean; overload; virtual; abstract;
    function WriteDouble(const aRow, aCol: Word; const D: Double): Boolean; overload; virtual; abstract;
    function WriteInteger(const aCell: string; const I: Integer): Boolean; overload; virtual; abstract;
    function WriteInteger(const aRow, aCol: Word; const I: Integer): Boolean; overload; virtual; abstract;
    function WriteInt64(const aCell: string; const I: Int64): Boolean; overload; virtual; abstract;
    function WriteInt64(const aRow, aCol: Word; const I: Int64): Boolean; overload; virtual; abstract;
    function WriteString(const aCell: string; const S: String): Boolean; overload; virtual; abstract;
    function WriteString(const aRow, aCol: Word; const S: String): Boolean; overload; virtual; abstract;
    function WriteVariant(const aCell: string; const V: Variant): Boolean; overload; virtual; abstract;
    function WriteVariant(const aRow, aCol: Word; const V: Variant): Boolean; overload; virtual; abstract;
    function WriteComment(const aCell: string; const S: string): Boolean; overload; virtual; abstract;
    function WriteComment(const aRow, aCol: Word; const S: string): Boolean; overload; virtual; abstract;
    constructor Create(Owner: IDBDExcelV2);
    destructor Destroy; override;
  end;

resourcestring
  rsEInvalidSheetIndex     = 'Задан неверный индекс для WorkBooks. Активация листа прервана';
  rsEInvalidSheetActivate  = 'Активация листа завершена с ошибкой';
  rsEInvalidBookNotOpen    = 'Книга ещё не открыта';
  rsEInvaidFileName        = 'Имя файла не может быть пустым';
  rsEInvaidExcelConnection = 'Ошибка подключения к MS Excel';
  rsEExcelNotFound         = 'Приложение MS Excel не установлено на этом компьютере';
  rsEInvalidWorkSheetName  = 'Название рабочего листа не может быть пустым';
  rsEInvalidCopyToTemp     = 'Не удалось создать временную копию файла';
  rsEInvalidBookOpened     = 'Книга уже открыта';

const
  ExcelApp = 'Excel.Application';
  lcid = LOCALE_USER_DEFAULT;

var
  oFalse: OleVariant;
  oTrue:  OleVariant;

/// Перевести адрес в формате (R1,C1) в формат (A1)  (256 колонок)
function xlRCtoA1(const ARow, ACol: Integer; RowAbsolute: Boolean = False; ColAbsolute: Boolean = False): String;
/// Перевести адрес в формат (R1,C1) из формата (A1)
function xlRCFromA1(const Addr: string; out ORow: Integer; out OCol: Integer): Boolean;

function xlStringToFloat(const xlStr: string; out d: Double): Boolean; overload;
function xlStringToFloat(const xlStr: string): Double; overload;
function xlStringToCurrency(const xlStr: string; out d: Currency): Boolean; overload;
function xlStringToCurrency(const xlStr: string): Currency; overload;
function xlStringToNumberString(const xlStr: string): string;

implementation

function xlStringToNumberString(const xlStr: string): string;
var s: string; i: Integer;
begin
  s := DBDReplace(xlStr,' ', '', true); i:=1;
  if not DBDSkipChars(s,'0123456789.,',i) then Result:=s
                                          else Result:=LeftStr(s,i-1);
end;
function xlStringToFloat(const xlStr: string; out d: Double): Boolean; overload;
var s: string; i: Integer;
begin
  s:=xlStringToNumberString(xlStr); i:=1;
  Result:=(s<>'') and DBDReadDouble(s,i,d);
  if not Result then d:=0.00;
end;
function xlStringToFloat(const xlStr: string): Double; overload;
begin
  if not xlStringToFloat(xlStr, Result) then Result:=0.00;
end;
function xlStringToCurrency(const xlStr: string; out d: Currency): Boolean; overload;
var t: Double;
begin
  Result := xlStringToFloat(xlStr, t);
  if Result then d:=t else d:=0;

end;
function xlStringToCurrency(const xlStr: string): Currency; overload;
begin
  if not xlStringToCurrency(xlStr, Result) then Result:=0;
end;

function xlRCtoA1(const ARow, ACol: Integer; RowAbsolute: Boolean = False; ColAbsolute: Boolean = False): 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 последний столбец
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;
function xlRCFromA1(const Addr: string; out ORow: Integer; out OCol: Integer): Boolean;
var p: Pointer; b: Byte;
begin
  p:=@Addr[1]; b:=Byte(p^);
  oRow:=0; oCol:=0;
  while b>0 do begin
    if b   in [$41..$5A] then oCol:=oCol*26+(b-$41)
    else if b in [$61..$7A] then oCol:=oCol*26+(b-$61)
    else if b in [$30..$39] then oRow:=oRow*10+(b-$30)
    else begin Result:=False; Break; end;
    Inc(p); b:=Byte(p^);
  end;
end;

{ TDBDExcelBase }

constructor TDBDExcelBase.Create(const WBOptions: TDBDOpenWBOprions = []; const aNotifier: IDBDNotifierV1=nil);
begin
  inherited Create;
  SetOptions(WBOptions);
  FNotifier := aNotifier;
  FCurrIdx := 0; FCountWB := 0; FCountWS := 0; FLastRow:=0; FLastCol:=0;
end;

constructor TDBDExcelBase.Create(tblDescr: TDBDTable; const WBOptions: TDBDOpenWBOprions; const aNotifier: IDBDNotifierV1);
begin
  FTable:=tblDescr;
end;

destructor TDBDExcelBase.Destroy;
begin
  FNotifier:=nil; rdr:=nil; wrt:=nil;
  inherited;
end;

function TDBDExcelBase.GetCountWB: Integer;
begin
  Result := FCountWB;
end;

function TDBDExcelBase.GetCountWS: Integer;
begin
  Result := FCountWS;
end;

function TDBDExcelBase.GetCurrentWSIndex: Integer;
begin
  Result := FCurrIdx;
end;

function TDBDExcelBase.GetOptions: TDBDOpenWBOprions;
begin
  Result :=FOptions;
end;

function TDBDExcelBase.GetReader: IDBDExcelReaderV2;
begin
  Result := rdr;
end;

function TDBDExcelBase.GetWorkSheetName: string;
begin
  Result := FNameWS;
end;

function TDBDExcelBase.GetWriter: IDBDExcelWriterV2;
begin
  Result := wrt;
end;

function TDBDExcelBase.LastCol: Integer;
begin
  Result := FLastCol;
end;

function TDBDExcelBase.LastRow: Integer;
begin
  Result := FLastRow;
end;

function TDBDExcelBase.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;

procedure TDBDExcelBase.SetOptions(const Value: TDBDOpenWBOprions);
begin
  FOptions := Value;
end;

{ TDBDExcelReaderBase }

constructor TDBDExcelReaderBase.Create(Owner: IDBDExcelV2);
begin
  inherited Create;
  FOwner := Owner;
end;

destructor TDBDExcelReaderBase.Destroy;
begin
  FOwner:=nil;
  inherited;
end;

function TDBDExcelReaderBase.GetWSName: string;
begin
  Result := FWSName;
end;

function TDBDExcelReaderBase.AsBoolean(const aRow, aCol: Word): Boolean;
begin
  if not AsBoolean(aRow, aCol, Result) then Result:=False;
end;

function TDBDExcelReaderBase.AsCurrency(const aRow, aCol: Word): Currency;
begin
  if not AsCurrency(aRow, aCol, Result) then Result:=0;
end;

function TDBDExcelReaderBase.AsDateTime(const aRow, aCol: Word): TDateTime;
begin
  if not AsDateTime(aRow, aCol, Result) then Result:=0.0;
end;

function TDBDExcelReaderBase.AsDouble(const aRow, aCol: Word): Double;
begin
  if not AsDouble(aRow, aCol, Result) then Result:=0.0;
end;

function TDBDExcelReaderBase.AsExtended(const aRow, aCol: Word): Extended;
begin
  if not AsExtended(aRow, aCol, Result) then Result:=0.0;
end;

function TDBDExcelReaderBase.AsInt64(const aRow, aCol: Word): Int64;
begin
  if not AsInt64(aRow, aCol, Result) then Result:=0;
end;

function TDBDExcelReaderBase.AsInteger(const aRow, aCol: Word): Integer;
begin
  if not AsInteger(aRow, aCol, Result) then Result:=0;
end;

function TDBDExcelReaderBase.AsString(const aRow, aCol: Word): string;
begin
  if not AsString(aRow, aCol, Result) then Result:='';
end;

function TDBDExcelReaderBase.AsVariant(const aRow, aCol: Word): Variant;
begin
  if not AsVariant(aRow, aCol, Result) then Result:=Null;
end;

{ TDBDExcelWriterBase }

constructor TDBDExcelWriterBase.Create(Owner: IDBDExcelV2);
begin
  inherited Create;
  FOwner := Owner;
end;

destructor TDBDExcelWriterBase.Destroy;
begin
  FOwner:=nil;
  inherited;
end;

function TDBDExcelWriterBase.GetWSName: string;
begin
  Result := FWSName;
end;

end.