qimport3xlsx.pas

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

    for i := 0 to Self.Count - 1 do
      if UpperCase(Items[i].Name) = UpperCase(Name) then
      begin
        Result := Items[i];
        Break;
      end;
end;

function TXlsxWorkSheetList.GetSheetByID(id: integer): TXlsxWorkSheet;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to Self.Count - 1 do
    if Items[i].SheetID = id then
    begin
      Result := Items[i];
      Break;
    end;
end;

{ TXlsxWorkbook }

procedure TXlsxWorkbook.LoadSharedStrings;
var
  SharedNode: IXMLDOMNode;
  XmlFileRec: TSearchRec;
  i: Integer;
begin
  try
    if FindFirst(FWorkDir + 'xl\sharedStrings.xml', faAnyFile, XmlFileRec) = 0 then
    begin
      FXMLDoc.load(FWorkDir + 'xl\sharedStrings.xml');
      SharedNode := FXMLdoc.selectSingleNode('/sst');
      for i := 0 to SharedNode.childNodes.length - 1 do
      begin
        FSharedStrings.Add;
        FSharedStrings[i].Text := SharedNode.childNodes[i].text;
      end;
    end;
  finally
    FindClose(XmlFileRec);
  end;
end;

procedure TXlsxWorkbook.LoadStyles;
var
  StyleNode: IXMLDOMNode;
  XmlFileRec: TSearchRec;
  i: Integer;
begin
  try
    if FindFirst(FWorkDir + 'xl\styles.xml', faAnyFile, XmlFileRec) = 0 then
    begin
      FXMLDoc.load(FWorkDir + 'xl\styles.xml');
      StyleNode := FXMLdoc.selectSingleNode('/styleSheet/cellXfs');
      for i := 0 to StyleNode.childNodes.length - 1 do
      begin
        FStyles.Add;
        if Assigned(StyleNode.childNodes[i].attributes) then
          if Assigned(StyleNode.childNodes[i].attributes.getNamedItem('numFmtId')) then
            FStyles[i].NumFmtId :=
              StyleNode.childNodes[i].attributes.getNamedItem('numFmtId').nodeValue;
      end;
    end;
  finally
    FindClose(XmlFileRec);
  end;
end;

procedure TXlsxWorkbook.SetWorkSheets;
var
  SheetNodes: IXMLDOMNodeList;
  XmlFileRec: TSearchRec;  
  i: Integer;
  TempWorkSheet: TXlsxWorkSheet;

  function GetSheetID(const r_id: string): integer;
  begin
    Result := StrToIntDef(Copy(r_id, 4, Length(r_id) - 3), 0);
  end;                    

begin
  try
    if FindFirst(FWorkDir + 'xl\workbook.xml', faAnyFile, XmlFileRec) = 0 then
    begin
      FXMLDoc.load(FWorkDir + 'xl\workbook.xml');
      SheetNodes := FXMLdoc.selectNodes('/workbook/sheets/sheet');
      for i := 0 to SheetNodes.length - 1 do
        if Assigned(SheetNodes[i].attributes.getNamedItem('name')) then
        begin
          if not Assigned(SheetNodes[i].attributes.getNamedItem('state')) then
          begin
            TempWorkSheet := FWorkSheets.Add;
            TempWorkSheet.Name := SheetNodes[i].attributes.getNamedItem('name').nodeValue;
            TempWorkSheet.SheetID := GetSheetID(SheetNodes[i].attributes.getNamedItem('r:id').nodeValue);
          end else
          if (SheetNodes[i].attributes.getNamedItem('state').nodeValue = 'hidden') and
            FLoadHiddenSheets then
            begin
              TempWorkSheet := FWorkSheets.Add;
              TempWorkSheet.Name := SheetNodes[i].attributes.getNamedItem('name').nodeValue;
              TempWorkSheet.IsHidden := True;
            end;
        end;
    end;
  finally
    FindClose(XmlFileRec);
  end;
end;

procedure TXlsxWorkbook.LoadWorkSheets;
var
  SRec: TSearchRec;
begin
  try
    if FindFirst(FWorkDir + 'xl\worksheets\sheet*.xml', faDirectory, SRec) = 0 then
    begin
      LoadSheet(FWorkDir + 'xl\worksheets\' + SRec.Name);
      while FindNext(SRec) = 0 do
        LoadSheet(FWorkDir + 'xl\worksheets\' + SRec.Name);
    end;
  finally
    FindClose(SRec);
  end;
end;

procedure TXlsxWorkbook.SetDataCells;
var
  i: Integer;
begin
  for i := 0 to FWorkSheets.Count - 1 do
    FWorkSheets[i].LoadDataCells;
end;

procedure TXlsxWorkbook.LoadSheet(SheetFile: string);
var
  DimNode, FirstMergeNode: IXMLDOMNode;
  CellNodes, MergeNodes: IXMLDOMNodeList;
  CurrentSheet: TXlsxWorkSheet;
  Dimension, Name: qiString;
  i, j, id, st: Integer;
  TempMerge: TXlsxMerge;
  TempCell: TXlsxCell;


  function XlsxDateTimeFormat(const DateTime: string): TDateTime;
  var
    TempStr: string;
  const
    cXMLDelimiter = '.';
  begin
    TempStr := DateTime;
    if DecimalSeparator <> cXMLDelimiter then
      if Pos(cXMLDelimiter, TempStr) > 0 then
        {$IFDEF VCL6}
        TempStr := AnsiReplaceStr(DateTime, cXMLDelimiter, DecimalSeparator);
        {$ELSE}
        TempStr := StringReplace(DateTime, cXMLDelimiter, DecimalSeparator, [rfReplaceAll, rfIgnoreCase]);
        {$ENDIF}
    Result := StrToFloat(TempStr);
  end;

  {$IFNDEF VCL6}
  function BoolToStr(B: Boolean; UseBoolStrs: Boolean = False): AnsiString;
  const
    cSimpleBoolStrs: array [boolean] of AnsiString = ('0', '-1');
  begin
    if UseBoolStrs then
    begin
      if B then
        Result := 'True'
      else
        Result := 'False';
    end
    else
      Result := cSimpleBoolStrs[B];
  end;
  {$ENDIF}

begin
  Name := ExtractFileName(SheetFile);
  id := StrToIntDef(Copy(Name, 6, Pos('.', Name) - 6), 0);
  CurrentSheet := FWorkSheets.GetSheetByID(id);
  if Assigned(CurrentSheet) then
  begin
    FXMLDoc.load(SheetFile);
    DimNode := FXMLdoc.selectSingleNode('/worksheet/dimension');
    Dimension := DimNode.attributes.getNamedItem('ref').nodeValue;

    MergeNodes := FXMLdoc.selectNodes('/worksheet/mergeCells/mergeCell');
    for i := 0 to MergeNodes.length - 1 do
    begin
      TempMerge := CurrentSheet.MergeCells.Add;
      TempMerge.Range := MergeNodes[i].attributes.getNamedItem('ref').nodeValue;
      FirstMergeNode := FXMLdoc.selectSingleNode('/worksheet/sheetData/row/c[@r ="' +
        TempMerge.FirstCellName + '"]/v');
      if Assigned(FirstMergeNode) then
        if Assigned(FirstMergeNode.parentNode.attributes.getNamedItem('t')) then
        begin
          if FirstMergeNode.parentNode.attributes.getNamedItem('t').nodeValue = 's' then
            TempMerge.Value := SharedStrings[StrToInt(FirstMergeNode.text)].Text
          else
          if FirstMergeNode.parentNode.attributes.getNamedItem('t').nodeValue = 'str' then
            TempMerge.Value := FirstMergeNode.text;
        end else
          TempMerge.Value := FirstMergeNode.text;
    end;

    CellNodes := FXMLdoc.selectNodes('/worksheet/sheetData/row/c');
    for i := 0 to CellNodes.length - 1 do
    begin
      TempCell := CurrentSheet.Cells.Add;
      TempCell.Name := CellNodes[i].attributes.getNamedItem('r').nodeValue;
      Dimension := CellNodes[i].attributes.getNamedItem('r').nodeValue;

      TempCell.Col := GetColIdFromString(Dimension);
      if CurrentSheet.ColCount < TempCell.Col then
        CurrentSheet.ColCount := TempCell.Col;
      TempCell.Row := GetRowIdFromString(Dimension);
      if CurrentSheet.RowCount < TempCell.Row then
        CurrentSheet.RowCount := TempCell.Row;
        
      for j := 0 to CellNodes[i].childNodes.length - 1 do
        if CellNodes[i].childNodes[j].nodeName = 'f' then
          TempCell.Formula :=
            CellNodes[i].childNodes[j].text
        else
        if CellNodes[i].childNodes[j].nodeName = 'v' then
          if Assigned(CellNodes[i].attributes.getNamedItem('t')) then
          begin
            if CellNodes[i].childNodes.item[j].text ='' then TempCell.Value := ''
            else 
            if CellNodes[i].attributes.getNamedItem('t').nodeValue = 's' then
              TempCell.Value :=
                SharedStrings[StrToInt(CellNodes[i].childNodes.item[j].text)].Text
            else
            if CellNodes[i].attributes.getNamedItem('t').nodeValue = 'str' then
              TempCell.Value :=
                CellNodes[i].childNodes[j].text
            else
            if CellNodes[i].attributes.getNamedItem('t').nodeValue = 'b' then
              TempCell.Value :=
                BoolToStr(Boolean(StrToIntDef(CellNodes[i].childNodes[j].text, 0)), True);
          end else
          begin
            if Assigned(CellNodes[i].attributes.getNamedItem('s')) then
            begin
              st := CellNodes[i].attributes.getNamedItem('s').nodeValue;
              if Styles.Count > st then
              begin
                case Styles.Items[st].NumFmtId of
                  14, 21, 165..187:
                    if CellNodes[i].childNodes[j].text <> '' then
                      TempCell.Value := DateTimeToStr(XlsxDateTimeFormat(CellNodes[i].childNodes[j].text));
                  else
                    TempCell.Value := CellNodes[i].childNodes[j].text;
                end;
              end else
                TempCell.Value := CellNodes[i].childNodes[j].text;
            end else
              TempCell.Value := CellNodes[i].childNodes[j].text;
          end;
      if NeedFillMerge then
        CurrentSheet.FillMerge(CurrentSheet.Cells[CurrentSheet.Cells.Count - 1]);
    end;
  end;
end;

constructor TXlsxWorkbook.Create;
begin
  inherited;
  FWorkDir := '';
  FLoadHiddenSheets := False;
  FNeedFillMerge := False;
  FXMLDoc := CoDOMDocument.Create;
  FSharedStrings := TXlsxSharedStringList.Create(TXlsxSharedStrings);
  FStyles := TXlsxStyleList.Create(TXlsxStyle);
  FWorkSheets := TXlsxWorkSheetList.Create(TXlsxWorkSheet);
end;

destructor TXlsxWorkbook.Destroy;
begin
  FXMLDoc := nil;
  if Assigned(FWorkSheets) then
    FWorkSheets.Free;
  if Assigned(FStyles) then
    FStyles.Free;
  if Assigned(FSharedStrings) then
    FSharedStrings.Free;
  inherited;
end;

procedure TXlsxWorkbook.Load;
begin
  if FWorkDir <> '' then
  begin
    LoadSharedStrings;
    LoadStyles;
    SetWorkSheets;
    LoadWorkSheets;
    SetDataCells;
  end;
end;

{ TXlsxFile }

constructor TXlsxFile.Create;
begin
  inherited;
  FWorkbook := TXlsxWorkbook.Create;
end;

destructor TXlsxFile.Destroy;
begin
  if Assigned(FWorkbook) then
    FWorkbook.Free;
  inherited;
end;

procedure TXlsxFile.LoadXML(CurrFolder: qiString);
begin
  FWorkbook.CurrFolder := CurrFolder;
  FWorkbook.Load;
end;

{ TQImport3Xlsx }

procedure TQImport3Xlsx.SetSheetName(const Value: string);
begin
  if FSheetName <> Value then
    FSheetName := Value;
end;

procedure TQImport3Xlsx.SetLoadHiddenSheet(const Value: Boolean);
begin
  if FLoadHiddenSheet <> Value then
    FLoadHiddenSheet := Value;
end;

procedure TQImport3Xlsx.SetNeedFillMerge(const Value: Boolean);
begin
  if FNeedFillMerge <> Value then
    FNeedFillMerge := Value;
end;

procedure TQImport3Xlsx.BeforeImport;
begin
  FXlsxFile := TXlsxFile.Create;
  FXlsxFile.Workbook.FLoadHiddenSheets := FLoadHiddenSheet;
  FXlsxFile.Workbook.NeedFillMerge := FNeedFillMerge;
  FXlsxFile.FileName := FileName;
  FXlsxFile.Load;
  if Assigned(FXlsxFile.Workbook.WorkSheets.GetSheetByName(FSheetName))then
    FTotalRecCount := FXlsxFile.Workbook.WorkSheets.GetSheetByName(FSheetName).RowCount;  
  inherited;
end;

procedure TQImport3Xlsx.StartImport;
begin
  inherited;
  FCounter := 0;
end;

function TQImport3Xlsx.CheckCondition: Boolean;
begin
  Result := FCounter < FTotalRecCount;
end;

function TQImport3Xlsx.Skip: Boolean;
begin
  Result := (SkipFirstRows > 0) and (FCounter < SkipFirstRows);
end;

procedure TQImport3Xlsx.ChangeCondition;
begin
  Inc(FCounter);
end;

procedure TQImport3Xlsx.FinishImport;
begin
  if not Canceled and not IsCSV then
  begin
    if CommitAfterDone then
      DoNeedCommit
    else if (CommitRecCount > 0) and ((ImportedRecs + ErrorRecs) mod CommitRecCount > 0) then
      DoNeedCommit;
  end;
end;

procedure TQImport3Xlsx.AfterImport;
begin
  FXlsxFile.Free;
  FXlsxFile := nil;
  inherited;
end;

procedure TQImport3Xlsx.FillImportRow;
var
  i, k: Integer;
  strValue: qiString;
  p: Pointer;
  mapValue: qiString;
begin
  FImportRow.ClearValues;
  for i := 0 to FImportRow.Count - 1 do
  begin
    if FImportRow.MapNameIdxHash.Search(FImportRow[i].Name, p) then
    begin
      k := Integer(p);
{$IFDEF VCL7}
      mapValue := Map.ValueFromIndex[k];
{$ELSE}
      mapValue := Map.Values[FImportRow[i].Name];
{$ENDIF}
      strValue := FXlsxFile.Workbook.WorkSheets.GetSheetByName(FSheetName).DataCells.Cells[GetColIdFromColIndex(mapValue) - 1, FCounter];
      FImportRow.SetValue(Map.Names[k], strValue, False);
    end;
    DoUserDataFormat(FImportRow[i]);
  end;
end;

function TQImport3Xlsx.ImportData: TQImportResult;
begin
  Result := qirOk;
  try
    try
      if Canceled  and not CanContinue then
      begin
        Result := qirBreak;
        Exit;
      end;
      DataManipulation;
    except
      on E:Exception do
      begin
        try
          DestinationCancel;
        except
        end;
        DoImportError(E);
        Result := qirContinue;
        Exit;
      end;
    end;
  finally
    if (not IsCSV) and (CommitRecCount > 0) and not CommitAfterDone and
       (
        ((ImportedRecs + ErrorRecs) > 0)
        and ((ImportedRecs + ErrorRecs) mod CommitRecCount = 0)
       )
    then
      DoNeedCommit;
    if (ImportRecCount > 0) and
       ((ImportedRecs + ErrorRecs) mod ImportRecCount = 0) then
      Result := qirBreak;
  end;
end;

procedure TQImport3Xlsx.DoLoadConfiguration(IniFile: TIniFile);
begin
  inherited;
  with IniFile do
  begin
    SkipFirstRows := ReadInteger(XLSX_OPTIONS, XLSX_SKIP_LINES, SkipFirstRows);
    SheetName := ReadString(XLSX_OPTIONS, XLSX_SHEET_NAME, SheetName);
    LoadHiddenSheet := ReadBool(XLSX_OPTIONS, XLSX_LOAD_HIDDEN_SHEET,
      LoadHiddenSheet);
    NeedFillMerge := ReadBool(XLSX_OPTIONS, XLSX_NEED_FILL_MERGE,
      NeedFillMerge);
  end;
end;

procedure TQImport3Xlsx.DoSaveConfiguration(IniFile: TIniFile);
begin
  inherited;
  with IniFile do
  begin
    WriteInteger(XLSX_OPTIONS, XLSX_SKIP_LINES, SkipFirstRows);
    WriteString(XLSX_OPTIONS, XLSX_SHEET_NAME, SheetName);
    WriteBool(XLSX_OPTIONS, XLSX_LOAD_HIDDEN_SHEET, LoadHiddenSheet);
    WriteBool(XLSX_OPTIONS, XLSX_NEED_FILL_MERGE, NeedFillMerge);
  end;
end;

constructor TQImport3Xlsx.Create(AOwner: TComponent);
begin
  inherited;
  SkipFirstRows := 0;
  FLoadHiddenSheet := False;
end;

{$ENDIF}
{$ENDIF}

end.