xlsmapparser3.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

unit XLSMapParser3;

{$I QImport3VerCtrl.Inc}

interface

uses Classes, XLSFile3;

type
  TRangeType = (rtCol, rtRow, rtCell, rtUnknown);
  TRangeDirection = (rdDown, rdUp, rdUnknown);
  TSheetIDType = (sitUnknown, sitName, sitNumber);

  TMapRow = class;

  TMapRange = class
  private
    FMapRow: TMapRow;
    FXLSFile: TxlsFile;

    FDirection: TRangeDirection;
    FSheetIDType: TSheetIDType;
    FSheetNumber: integer;
    FSheetName: WideString;

    FRow1: integer;
    FCol1: integer;
    FRow2: integer;
    FCol2: integer;

    FRangeType: TRangeType;
    FLength: integer;

    procedure Arrange;
    function GetHasSheet: boolean;
    function GetAsString: string;
    function GetSkipFirstRows: integer;
    function GetSkipFirstCols: integer;
  protected
    procedure UpdateDirection;
  public
    constructor Create(MapRow: TMapRow);
    procedure Update;
    procedure Assign(Range: TMapRange);

    property MapRow: TMapRow read FMapRow write FMapRow;
    property XLSFile: TxlsFile read FXLSFile;

    property RangeType: TRangeType read FRangeType;
    property Direction: TRangeDirection read FDirection write FDirection;
    property HasSheet: boolean read GetHasSheet;
    property SheetIDType: TSheetIDType read FSheetIDType write FSheetIDType;
    property SheetNumber: integer read FSheetNumber write FSheetNumber; // 1 based
    property SheetName: WideString read FSheetName write FSheetName;

    property Row1: integer read FRow1 write FRow1; // 1 based
    property Col1: integer read FCol1 write FCol1; // 1 based
    property Row2: integer read FRow2 write FRow2; // 1 based
    property Col2: integer read FCol2 write FCol2; // 1 based

    property Length: integer read FLength;
    property AsString: string read GetAsString;

    property SkipFirstRows: integer read GetSkipFirstRows;
    property SkipFirstCols: integer read GetSkipFirstCols;
  end;

  TMapRowList = class;

  TMapRow = class(TList)
  private
    FMapRowList: TMapRowList;
    FXLSFile: TxlsFile;
    FLength: integer;
    function GetItems(Index: integer): TMapRange;
    procedure SetItems(Index: integer; Value: TMapRange);
    function GetAsString: string;
    procedure SetAsString(const Value: string);
    function GetSkipFirstRows: integer;
    function GetSkipFirstCols: integer;
  public
    constructor Create(MapRowList: TMapRowList);
    function Add(Item: TMapRange): integer;
    procedure Delete(Index: integer);
    procedure Update;
    function GetCellValue(AbsoluteIndex: integer): WideString;
    procedure Optimize;
    function IndexOfRange(const RangeStr: string): integer;

    property MapRowList: TMapRowList read FMapRowList;
    property XLSFile: TxlsFile read FXLSFile;

    property Items[Index: integer]: TMapRange read GetItems
      write SetItems; default;
    property Length: integer read FLength;
    property AsString: string read GetAsString write SetAsString;

    property SkipFirstRows: integer read GetSkipFirstRows;
    property SkipFirstCols: integer read GetSkipFirstCols;
  end;

  TMapRowList = class(TList)
  private
    FXLSFile: TxlsFile;
    FMaxRow: integer;
    FMinRow: integer;
    FSkipFirstCols: integer;
    FSkipFirstRows: integer;
    function GetItems(Index: integer): TMapRow;
    procedure SetItems(Index: integer; Value: TMapRow);
  public
    constructor Create(XLSFile: TxlsFile);
    function Add(Item: TMapRow): integer;
    procedure Delete(Index: integer);
    procedure Update;

    property XLSFile: TxlsFile read FXLSFile;
    property Items[Index: integer]: TMapRow read GetItems
      write SetItems; default;
    property MaxRow: integer read FMaxRow;
    property MinRow: integer read FMinRow;

    property SkipFirstRows: integer read FSkipFirstRows write FSkipFirstRows;
    property SkipFirstCols: integer read FSkipFirstCols write FSkipFirstCols;
  end;

  TCellNeighbour = (cnLeft, cnRight, cnTop, cnBottom);
  TCellNeighbours = set of TCellNeighbour;

  function ParseMapString(const MapString: string; MapRow: TMapRow): boolean;
  procedure ParseCellString(const CellString: string; var Col, Row: integer);
  procedure ParseColString(const ColString: string; var Col: integer);
  procedure ParseRowString(const RowString: string; var Row: integer);
  procedure ParseSheetNumber(const SheetNumber: string; var Sheet: integer);
  procedure ParseSheetName(const SheetName: string; var Sheet: string);

  function CellInRange(Range: TMapRange; const SheetName: string;
    SheetNumber, Col, Row: integer): boolean;
  function CellInRow(MapRow: TMapRow; const SheetName: string;
    SheetNumber, Col, Row: integer): boolean;
  function GetCellNeighbours(MapRow: TMapRow; const SheetName: string;
    SheetNumber, Col, Row: integer): TCellNeighbours;
  procedure RemoveCellFromRow(MapRow: TMapRow; const SheetName: string;
    SheetNumber, Col, Row: integer);

  procedure Str2ColRow(const Str: string; var ACol, ARow: integer);
  procedure Str2Range(const Str: string; var ACol1, ARow1, ACol2, ARow2: integer);
  function GetRangeType(const Str: string): TRangeType;
  function OptimizeString(const Str: string): string;
  function SkipFirstRows(const Str: string; Rows: integer): string;
  function SkipFirstCols(const Str: string; Cols: integer): string;
  function CheckRange(const Str: string): string;

const
  MAX_COL = 256;
  MAX_ROW = 65536;

const
  RANGE_DELIMITER     = ';';
  ARRAY_DELIMITER     = '-';
  SHEET_START         = '[';
  SHEET_FINISH        = ']';
  SHEET_NUMBER        = ':';
  ILLEGAL_IN_SHEET    = ':\/?*[]';

  COLSTART  = 'COLSTART';
  COLFINISH = 'COLFINISH';
  ROWSTART  = 'ROWSTART';
  ROWFINISH = 'ROWFINISH';

implementation

uses SysUtils, XLSUtils3, Math{$IFDEF VCL9}, Windows{$ENDIF};

type
  TSymbolType = (stUnknown, stLetter, stNumber, stRange, stArray,
    stSheetStart, stSheetFinish, stSheetNumber);

const
  sUnknownSymbol          = 'The %s symbol at position %d is unknown';
  sUnexpectedSymbol       = 'The symbol %s at position %d is unexpected';
  sUnexpectedKeyword      = 'Expect %s but %s found';
  sIllegalSheetChar       = 'Illegal char %s in sheet name at position %d';
  sLetterExpected         = 'Letter expected but %s found (position %d)';
  sNumberExpected         = 'Number expected but %s found (position %d)';
  sLetterOrNumberExpected = 'Letter or number expected but %s found (position %d)';
  sColIsOutOfRange        = 'Column %d is out of range [%s..%s]';
  sRowIsOutOfRange        = 'Row %d is out of range [%d..%d]';
  sRangeFail              = 'Range %s is fail. It must be COL or ROW';
  sUnexpectedEndOfRange   = 'Unexpected end of range';
  sSheetNotFound          = 'Sheet with name %s is not found in the source file';
  sRowNotFound            = 'Row %d not found in the sheet %s';
  sColNotFound            = 'Col %d not found in the sheet %s';
  sCellIsEmpty            = 'Cell is empty';
  sSoLongCellDefinition   = 'So long cell definition';
  sColIsEmpty             = 'Col is empty';
  sSoLongColDefinition    = 'So long col definition';
  sRowIsEmpty             = 'Row is empty';
  sSoLongRowDefinition    = 'So long row definition';
  sSheetIsEmpty           = 'Sheet is empty';
  sSoLongSheetDefinition  = 'So long sheet definition';

function IsLetter(Ch: char): boolean;
begin
  Result := Pos(Ch, LETTERS) > 0;
end;

function IsNumber(Ch: char): boolean;
begin
  Result := Pos(Ch, NUMBERS) > 0;
end;

function IsRange(Ch: char): boolean;
begin
  Result := Ch = RANGE_DELIMITER;
end;

function IsArray(Ch: char): boolean;
begin
  Result := Ch = ARRAY_DELIMITER;
end;

function IsSheetStart(Ch: char): boolean;
begin
  Result := Ch = SHEET_START;
end;

function IsSheetFinish(Ch: char): boolean;
begin
  Result := Ch = SHEET_FINISH;
end;

function IsSheetNumber(Ch: char): boolean;
begin
  Result := Ch = SHEET_NUMBER;
end;

function IsIllegalInSheet(Ch: char): boolean;
begin
  Result := Pos(Ch, ILLEGAL_IN_SHEET) > 0;
end;

function IsColStart(const Str: string): boolean;
begin
  Result := AnsiCompareText(Str, COLSTART) = 0;
end;

function IsColFinish(const Str: string): boolean;
begin
  Result := AnsiCompareText(Str, COLFINISH) = 0;
end;

function IsRowStart(const Str: string): boolean;
begin
  Result := AnsiCompareText(Str, ROWSTART) = 0;
end;

function IsRowFinish(const Str: string): boolean;
begin
  Result := AnsiCompareText(Str, ROWFINISH) = 0;
end;

function IsKeyword(const Str: string): boolean;
begin
  Result := IsColStart(Str) or IsColFinish(Str) or
    IsRowStart(Str) or IsRowFinish(Str);
end;

function IsColKeyword(const Str: string): boolean;
begin
  Result := IsColStart(Str) or IsColFinish(Str);
end;

function IsRowKeyword(const Str: string): boolean;
begin
  Result := IsRowStart(Str) or IsRowFinish(Str);
end;

function GetSymbolType(Ch: char): TSymbolType;
begin
  if IsLetter(Ch) then
    Result := stLetter
  else if IsNumber(Ch) then
    Result := stNumber
  else if IsRange(Ch) then
    Result := stRange
  else if IsArray(Ch) then
    Result := stArray
  else if IsSheetStart(Ch) then
    Result := stSheetStart
  else if IsSheetFinish(Ch) then
    Result := stSheetFinish
  else if IsSheetNumber(Ch) then
    Result := stSheetNumber
  else Result := stUnknown;
end;

procedure CheckRowNumber(Row: integer);
begin
  if (Row <= 0) or (Row > MAX_ROW) then
    raise Exception.CreateFmt(sRowIsOutOfRange, [Row, 1, MAX_ROW]);
end;

procedure CheckColNumber(Col: integer);
begin
  if (Col <= 0) or (Col > MAX_COL) then
    raise Exception.CreateFmt(sColIsOutOfRange, [Col, 'A', 'AZ']);
end;


function ParseMapString(const MapString: string; MapRow: TMapRow): boolean;
type
  TState = 0..14;
var
  State: TState;
  SheetFlag: boolean;
  RangeType: TRangeType;
  i: integer;
  Str, Buf: string;
  MapRange: TMapRange;
  SymbolType: TSymbolType;
  Ch: char;
  T: integer;
begin
  Result := true;
  Str := Trim(MapString);
  if Str = EmptyStr then Exit;
  //for i := Length(Str) downto 1 do if Str[i] = ' ' then System.Delete(Str, i, 1);
  Str := UpperCase(Str);
  if Str[Length(Str)] <> ';' then
    Str := Str + ';';

  State := 0;
  SheetFlag := false;
  RangeType := rtUnknown;
  MapRange := nil;

  for i := 1 to Length(Str) do
  begin
    Ch := Str[i];

    SymbolType := GetSymbolType(Ch);
    if (SymbolType = stUnknown) and not (State in [11, 12]) then
      raise Exception.CreateFmt(sUnknownSymbol, [Ch, i]);

    Result := true;

    try
      case State of
        0: begin
          if not SheetFlag and Assigned(MapRow) and Assigned(MapRange) then
            MapRow.Add(MapRange);
          if not SheetFlag and Assigned(MapRow) then
            MapRange := TMapRange.Create(MapRow);
          Buf := EmptyStr;
          case SymbolType of
            stLetter: State := 1;
            stNumber: State := 8;
            stSheetStart: State := 11;
            else begin
              if IsRange(Ch)
                then raise Exception.Create(sUnexpectedEndOfRange)
                else raise Exception.CreateFmt(sUnexpectedSymbol, [Ch, i]);
            end;
          end;
        end;
        1: case SymbolType of
             stLetter: State := 1;
             stNumber: begin // Buf contains col name
               T := Letter2Col(Buf);
               CheckColNumber(T);
               if Assigned(MapRange) then MapRange.Col1 := T;
               Buf := EmptyStr;
               State := 2;
             end;
             stArray: begin // Buf contains col name or keyword
               T := Letter2Col(Buf);
               if (T <= 0) or (T > MAX_COL) then
               begin
                 if IsKeyword(Buf) then // expects a cell
                 begin
                   if IsRowKeyword(Buf) then
                   begin
                     RangeType := rtRow;
                     if IsRowStart(Buf)
                       then MapRange.Direction := rdDown
                       else MapRange.Direction := rdUp;
                   end
                   else begin
                     if IsColStart(Buf)