Thema: Delphi Datensätze aus Tabelle holen und in Datei speichern

Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#7

AW: Datensätze aus Tabelle holen und in Datei speichern

  Alt 3. Jun 2013, 09:10
Also hierfür bietet sich das Strategy Design Pattern an.

Hier eine beispielhafte Umsetzung

zusammenfalten · markieren
Delphi-Quellcode:
unit Document;

interface

type
  TDocument = class;

  IDocumentExportFileStrategy = interface
    ['{787B60E5-A3CA-485C-A46E-248A43D7175C}']
    procedure ExportDoc( AContext : TDocument; const AFileName : string );
  end;

  TDocument = class
  private
    FExportFileStrategy : IDocumentExportFileStrategy;
  protected
    function GetValue( const Name : string ) : Variant; virtual; abstract;
  public
    procedure First; virtual; abstract;
    procedure Next; virtual; abstract;
    function Eof : Boolean; virtual; abstract;

    property Value[const Name : string] : Variant read GetValue;

    property ExportFileStrategy : IDocumentExportFileStrategy read FExportFileStrategy write FExportFileStrategy;

    procedure ExportTo( const AFileName : string );
  end;

implementation

{ TDocument }

procedure TDocument.ExportTo( const AFileName : string );
begin
  FExportFileStrategy.ExportDoc( Self, AFileName );
end;

end.
Die Export-Strategie für Xliff (Plain-Text)
zusammenfalten · markieren
Delphi-Quellcode:
unit XliffPlainExporter;

interface

uses
  Document,

  SysUtils, Variants,
  Classes;

type
  TXliffPlainExporter = class( TInterfacedObject, IDocumentExportFileStrategy )
  private
    procedure WriteLine( AStream : TStream; ALine : string );
  protected
    procedure WriteHead( AContext : TDocument; AStream : TStream );
    procedure WriteDetails( AContext : TDocument; AStream : TStream );
    procedure WriteFoot( AContext : TDocument; AStream : TStream );
  public
    procedure ExportDoc( AContext : TDocument; const AFileName : string );
  end;

implementation

{ TXmlExporter }

procedure TXliffPlainExporter.ExportDoc( AContext : TDocument; const AFileName : string );
var
  LStream : TStream;
  LFileName : string;
begin
  AContext.First;
  if not AContext.Eof
  then
    begin

      LFileName := AFileName;
      if ExtractFileExt( LFileName ) = ''
      then
        LFileName := ChangeFileExt( LFileName, '.xml' );

      LStream := TFileStream.Create( LFileName, fmCreate );
      try
        WriteHead( AContext, LStream );
        WriteDetails( AContext, LStream );
        WriteFoot( AContext, LStream );
      finally
        LStream.Free;
      end;

    end;
end;

procedure TXliffPlainExporter.WriteHead( AContext : TDocument; AStream : TStream );
begin
  WriteLine( AStream, '<?xml version=''1.0'' encoding=''utf-8''?>' );
  WriteLine( AStream, '<xliff version="1.1">' );
  WriteLine( AStream, ' <file original="source\simple.htm" source-language="EN" target-language="DE" datatype="html">' );
  WriteLine( AStream, ' <header>' );
  WriteLine( AStream, ' <skl>' );
  WriteLine( AStream, ' <external-file uid="017dbcf0-c82c-11e2-ba2b-005056c00008" href="skl\simple.htm.skl"/>' );
  WriteLine( AStream, ' </skl>' );
  WriteLine( AStream, ' </header>' );
  WriteLine( AStream, ' <body>' );
end;

procedure TXliffPlainExporter.WriteDetails( AContext : TDocument; AStream : TStream );
begin
  while not AContext.Eof do
    begin
      WriteLine( AStream, Format( ' <trans-unit id="%s">', [VarToStr( AContext.Value['id'] )] ) );
      WriteLine( AStream, Format( ' <source xml:lang="EN">%s</source>', [VarToStr( AContext.Value['src'] )] ) );
      WriteLine( AStream, Format( ' <target xml:lang="DE">%s</target>', [VarToStr( AContext.Value['dst'] )] ) );
      WriteLine( AStream, ' <note/></trans-unit>' );

      AContext.Next;
    end;
end;

procedure TXliffPlainExporter.WriteFoot( AContext : TDocument; AStream : TStream );
begin
  WriteLine( AStream, ' </body>' );
  WriteLine( AStream, ' </file>' );
  WriteLine( AStream, '</xliff>' );
end;

procedure TXliffPlainExporter.WriteLine( AStream : TStream; ALine : string );
var
  LLine : TStream;
begin
  LLine := TStringStream.Create( ALine + sLineBreak, TEncoding.UTF8 );
  try
    LLine.Position := 0;
    AStream.CopyFrom( LLine, LLine.Size );
  finally
    LLine.Free;
  end;
end;

end.
Ein konkretes Test-Dokument
zusammenfalten · markieren
Delphi-Quellcode:
unit TestDocument;

interface

uses
  Document;

type
  TTestDocument = class( TDocument )
  private
    FIndex : Integer;
  protected
    function GetValue( const Name : string ) : Variant; override;
  public
    function Eof : Boolean; override;
    procedure First; override;
    procedure Next; override;
  end;

implementation

uses
  SysUtils,
  StrUtils;

{ TTestDocument }

function TTestDocument.Eof : Boolean;
begin
  Result := FIndex >= 100;
end;

procedure TTestDocument.First;
begin
  inherited;
  FIndex := 0;
end;

function TTestDocument.GetValue( const Name : string ) : Variant;
begin
  case IndexText( Name, ['id', 'src', 'dst'] ) of
    0 :
      Result := Format( 'id%8.8d', [FIndex + 1] );
    1 :
      Result := Format( 'src%8.8d', [FIndex + 1] );
    2 :
      Result := Format( 'dst%8.8d', [FIndex + 1] );
  end;
end;

procedure TTestDocument.Next;
begin
  inherited;
  Inc( FIndex );
end;

end.
und das Hauptprogramm zum Testen
zusammenfalten · markieren
Delphi-Quellcode:
program DataExportStrategy;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils,
  Document in 'Document.pas',
  TestDocument in 'TestDocument.pas',
  XliffPlainExporter in 'XliffPlainExporter.pas';

procedure Test;
var
  LDoc : TDocument;
begin
  LDoc := TTestDocument.Create;
  try
    LDoc.ExportFileStrategy := TXliffPlainExporter.Create;
    LDoc.ExportTo( 'test' );
  finally
    LDoc.Free;
  end;

  WriteLn( 'Export finished' );
end;

begin
  try

    Test;

  except
    on E : Exception do
      WriteLn( E.ClassName, ': ', E.Message );
  end;

  ReadLn;

end.
Wenn du ein TDataSetDocument benötigst, dann bau es dir so
zusammenfalten · markieren
Delphi-Quellcode:
unit DataSetDocument;

interface

uses
  Document,
  Data.DB;

type
  TDataSetDocument = class( TDocument )
  private
    FDataSet : TDataSet;
  protected
    function GetValue( const Name : string ) : Variant; override;
  public
    constructor Create( ADataSet : TDataSet );

    function Eof : Boolean; override;
    procedure Next; override;
    procedure First; override;
  end;

implementation

{ TDataSetDocument }

constructor TDataSetDocument.Create( ADataSet : TDataSet );
begin
  inherited Create;
  FDataSet := ADataSet;
end;

function TDataSetDocument.Eof : Boolean;
begin
  Result := FDataSet.Eof;
end;

procedure TDataSetDocument.First;
begin
  inherited;
  FDataSet.First;
end;

function TDataSetDocument.GetValue( const Name : string ) : Variant;
begin
  Result := FDataSet.FieldByName( Name ).Value;
end;

procedure TDataSetDocument.Next;
begin
  inherited;
  FDataSet.Next;
end;

end.
und fertig ...

Benötigst du weitere (oder anders funktionierende) Export-Formate (z.B. CSV oder XML mit XMLDoc), dann einfach eine neue Strategie-Klasse implemetieren, dem Document zuweisen und Exportieren lassen.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat