⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 qimport3ods.pas

📁 EMS Advanced Import Component Suite 允许你把数据从文件导入数据库中
💻 PAS
📖 第 1 页 / 共 2 页
字号:
        if Assigned(Nodes[I].attributes.getNamedItem('table:number-rows-spanned')) then
        begin
          NumbOfRepRows :=
            Nodes[I].attributes.getNamedItem('table:number-rows-spanned').nodeValue - 1;
          IsSpanning := true;
        end;
        if Assigned(Nodes[I].attributes.getNamedItem('table:number-columns-spanned')) then
        begin
          NumbOfRepColumns :=
            Nodes[I].attributes.getNamedItem('table:number-columns-spanned').nodeValue - 1;
          IsSpanning := true;
        end;
       if not Nodes[I].HasChildNodes then
         if (NumbOfRepRows > 0) or (NumbOfRepColumns > 0) then
           if not IsSpanning then
           begin
             if Table.X + NumbOfRepColumns + 1 > Table.ColCount then
               Table.ColCount := Table.X + NumbOfRepColumns + 1;
             if Table.Y + NumbOfRepRows + 1 > Table.RowCount then
               Table.RowCount := Table.Y + NumbOfRepRows + 1;
             Table.X := Table.X + NumbOfRepColumns;
             Table.Y := Table.Y + NumbOfRepRows;
           end
      end;
      if Nodes[I].HasChildNodes then
        ParseTable(Table, Nodes[I].ChildNodes, NumbOfRepColumns,
           NumbOfRepRows, IsSpanning);
    end
    else
    begin
      if (NumbOfRepRows > 0) or (NumbOfRepColumns > 0) then
      begin
        ExpandRowsNCols(Table, Nodes[I].NodeValue,
          NumbOfRepRows, NumbOfRepColumns, IsSpanning);
        if not IsSpanning then
        begin
          Table.X := Table.X + NumbOfRepColumns;
          Table.Y := Table.Y + NumbOfRepRows;
        end;
      end
      else
      begin
        TempCell := Table.Cells.Add;
        TempCell.Row := Table.Y;
        TempCell.Col := Table.X;
        TempCell.Value := Nodes[I].nodeValue;
      end;
    end;
  end;
end;

procedure TODSWorkBook.ExpandRowsNCols(Table: TODSSpreadSheet;
  ExpandValue: qiString;
  NumbOfRepRows, NumbOfRepColumns: Integer; IsSpanning: Boolean);
var
  I: Integer;
  TempCell: TODSCell;
begin
  I := NumbOfRepRows;
  if Table.X + NumbOfRepColumns + 1 > Table.ColCount then
    Table.ColCount := Table.X + NumbOfRepColumns + 1;
  if Table.Y + NumbOfRepRows + 1 > Table.RowCount then
    Table.RowCount := Table.Y + NumbOfRepRows + 1;
  if NumbOfRepColumns >= 0 then
  begin
    repeat
      if not IsSpanning
      then
      begin
        TempCell := Table.Cells.Add;
        TempCell.Row := Table.Y + I;
        TempCell.Col := Table.X + NumbOfRepColumns;
        TempCell.Value := ExpandValue;
      end
      else
      begin
        if IsNotExpanding then
        begin
          if (NumbOfRepColumns = 0) and (I = 0) then
          begin
            TempCell := Table.Cells.Add;
            TempCell.Row := Table.Y;
            TempCell.Col := Table.X;
            TempCell.Value := ExpandValue;
          end;
        end
        else
        begin
          TempCell := Table.Cells.Add;
          TempCell.Row := Table.Y + I;
          TempCell.Col := Table.X + NumbOfRepColumns;
          TempCell.Value := ExpandValue;
        end;
      end;
      I := I - 1;
    until (I < 0);
    ExpandRowsNCols(Table, ExpandValue, NumbOfRepRows,
      NumbOfRepColumns - 1, IsSpanning);
  end;
end;

procedure TODSWorkbook.SetSpreadSheets;
var
  SRec: TSearchRec;
begin
  try
    if FindFirst(FWorkDir + 'content.xml', faDirectory, SRec) = 0 then
    begin
      FindTables(FWorkDir + 'content.xml');
    end
    else
      FindTables(FWorkDir + FileName);
  finally
    FindClose(SRec);
  end;
end;

constructor TODSWorkbook.Create;
begin
  FXMLDoc := CoDOMDocument.Create;
  FSpreadSheets := TODSSpreadSheetList.Create(TODSSpreadSheet);
  FIsNotExpanding := true;
  FWorkDir := '';
  FileName := '';
end;

destructor TODSWorkbook.Destroy;
begin
  FXMLDoc := nil;
  FSpreadSheets.Free;
  inherited;
end;

procedure TODSWorkbook.Load;
begin
  if FWorkDir <> '' then
  begin
    SetSpreadSheets;
  end;
end;

{ TODSFile }

procedure TODSFile.LoadXML(WorkDir: qiString);
begin
  FWorkbook.WorkDir := WorkDir;
  FWorkbook.Load;
end;

constructor TODSFile.Create;
begin
  inherited;
  FWorkbook := TODSWorkbook.Create;
end;

destructor TODSFile.Destroy;
begin
  FWorkbook.Free;
  inherited;
end;

{TQImport3ODS}

procedure TQImport3ODS.AfterImport;
begin
  FODSFile.Free;
  inherited;
end;

procedure TQImport3ODS.BeforeImport;
begin
  inherited;
  FODSFile := TODSFile.Create;
  FODSFile.FileName := FileName;
  FODSFile.Workbook.IsNotExpanding := NotExpandMergedValue;
  FODSFile.Load;
  if Assigned(FODSFile.Workbook.SpreadSheets.GetSheetByName(FSheetName)) then
    FTotalRecCount := FODSFile.Workbook.SpreadSheets.GetSheetByName(FSheetName).RowCount;
end;

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

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

constructor TQImport3ODS.Create(AOwner: TComponent);
begin
  inherited;
  SkipFirstRows := 0;
  NotExpandMergedValue := true;
end;

procedure TQImport3ODS.DoLoadConfiguration(IniFile: TIniFile);
begin
  inherited;
  with IniFile do
  begin
    SkipFirstRows := ReadInteger(ODS_OPTIONS, ODS_SKIP_LINES, SkipFirstRows);
    SheetName := AnsiString( ReadString(ODS_OPTIONS, ODS_SHEET_NAME,
      string(SheetName)));
    NotExpandMergedValue :=
      ReadBool(ODS_OPTIONS, ODS_NOT_EXPAND_MERGED_VALUE, NotExpandMergedValue);
  end;
end;

procedure TQImport3ODS.DoSaveConfiguration(IniFile: TIniFile);
begin
  inherited;
  with IniFile do
  begin
    WriteInteger(ODS_OPTIONS, ODS_SKIP_LINES, SkipFirstRows);
    WriteString(ODS_OPTIONS, ODS_SHEET_NAME, string(SheetName));
    WriteBool(ODS_OPTIONS, ODS_NOT_EXPAND_MERGED_VALUE, NotExpandMergedValue);
  end;
end;

procedure TQImport3ODS.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 := FODSFile.Workbook.SpreadSheets.GetSheetByName(FSheetName).DataCells.Cells[GetColIdFromColIndex(mapValue) - 1, FCounter];
      FImportRow.SetValue(Map.Names[k], strValue, False);
    end;
    DoUserDataFormat(FImportRow[i]);
  end;
end;

procedure TQImport3ODS.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;

function TQImport3ODS.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 TQImport3ODS.SetSheetName(const Value: AnsiString);
begin
  if (FSheetName <> Value) then
    FSheetName := Value;
end;


procedure TQImport3ODS.SetExpandFlag(const Value: Boolean);
begin
  if (Value <> FNotExpandMergedValue) then
    FNotExpandMergedValue := Value;
end;

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

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

{$ENDIF}
{$ENDIF}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -