Einzelnen Beitrag anzeigen

Blup

Registriert seit: 7. Aug 2008
Ort: Brandenburg
1.464 Beiträge
 
Delphi 12 Athens
 
#17

AW: Einlesen einer FORTRAN Binärdatei mit Delphi

  Alt 17. Jul 2014, 11:15
ich würde das im Prinzip so aufbauen:
Delphi-Quellcode:
unit FortranWriter;

interface

type
  TFortranObjectWriter = abstract class(TObject)
  protected
    class procedure GetDataObjectClass: TClass; virtual; abstract;
    class procedure WriteToBuffer(ABuffer: TCustomStream; AValue: Double); overload:
    class procedure WriteToBuffer(ABuffer: TCustomStream; AValue: Integer); overload:
    class procedure Register;
    class procedure UnRegister;
  public
    class property DataObjectClass: TClass read GetDataObjectClass;
    class procedure WriteObjectToBuffer(ABuffer: TCustomStream; AObject: TObject); virtual; abstract;
  end;

  TFortranObjectWriterClass = class of TFortranObjectWriter;

  TFortranWriter = class(TObject)
    constructor Create(AStream: TCustomStream);
    destructor Destroy;
  private
    FBuffer: TMemmoryStream;
    FStream: TCustomStream;
    class var FObjectWriter: TClassList;
  protected
    class procedure RegisterObjectWriter(AClass: TFortranObjectWriterClass);
    class procedure UnRegisterObjectWriter(AClass: TFortranObjectWriterClass);
    class procedure GetObjectWriter(AClass: TClass): TFortranObjectWriterClass;
  public
    procedure Write(AObject: TObject); virtual;
  end;

implementation

constructor TFortranWriter.Create(AStream: TCustomStream);
begin
  inherited Create;
  
  FStream := AStream;
  FBuffer := TMemmoryStream.Create;
end;

destructor TFortranWriter.Destroy;
begin
  FBuffer.Free;

  inherited;
end;

procedure TFortranWriter.Write(AObject: TObject);
var
  ObjectWriter: TFortranObjectWriterClass;
  ByteSize: Byte;
begin
  FBuffer.Clear;
  ObjectWriter := GetObjectWriter(AObject.Class);
  if not Assigned(ObjectWriter) then
    raise Exception.Create('...');

  ObjectWriter.WriteObjectToBuffer(FBuffer, AObject);
  if FBuffer.Size = 0 then
    raise Exception.Create('...');
  if FBuffer.Size > 255 then
    raise Exception.Create('...');

  ByteSize := FBuffer.Size;

  FStream.Write(ByteSize, SizeOf(ByteSize));
  FBuffer.WriteToStream(FStream);
  FStream.Write(ByteSize, SizeOf(ByteSize));
end;

class procedure TFortranWriter.RegisterObjectWriter(AClass: TFortranObjectWriterClass);
begin
  if not Assigned(FObjectWriter) then
    FObjectWriter := TClassList.Create;

  FObjectWriter.Add(AClass);
end;

class procedure TFortranWriter.UnregisterObjectWriter(AClass: TFortranObjectWriterClass);
begin
  if not Assigned(FObjectWriter) then
    Exit;

  FObjectWriter.Remove(AClass);

  if FObjectWriter.Count = 0 then
    FreeAndNil(FObjectWriter);
end;

class procedure TFortranWriter.GetObjectWriter(AClass: TClass): TFortranObjectWriterClass;
begin
  if Assigned(FObjectWriter) then
  begin
    for i := FObjectWriter.Count - 1 downto 0 do
    begin
      Result := TFortranObjectWriter(FObjectWriter[i]);
      if AClass is Result.DataObjectClass then
        Exit;
    end;
  end;
  Result := nil;
end;

class procedure TFortranObjectWriter.WriteToBuffer(ABuffer: TCustomStream; AValue: Double);
begin
  ABuffer.Write(AValue, SizeOf(AValue));
end;

class procedure TFortranObjectWriter.WriteToBuffer(ABuffer: TCustomStream; AValue: Integer);
begin
  ABuffer.Write(AValue, SizeOf(AValue));
end;

class procedure TFortranObjectWriter.Register;
begin
  TFortranWriter.Register(Self);
end;

class procedure TFortranObjectWriter.UnRegister;
begin
  TFortranWriter.UnRegister(Self);
end;

end.
Delphi-Quellcode:
unit MyDataObject;

interface

type
  TMyDataObject = class(TObject)
  private
    FA: Double;
    FB: Integer;
    FC: Integer;
  published
    property A: Double read FA write FA;
    property B: Integer read FB wirte FB;
    property C: Integer read FC write FC;
  end;
Delphi-Quellcode:
unit FortranMyDataObject;

interface

implementation

type
  TMyDataObjectFortranWriter = class(TFortranObjectWriter)
  protected
    class procedure GetDataObjectClass: TClass; override;
  public
    class procedure WriteObjectToBuffer(ABuffer: TCustomStream; AObject: TObject); override;
  end;

class procedure TMyDataObjectFortranWriter.GetDataObjectClass: TClass;
begin
  Result := TMyDataObject;
end;

class procedure TMyDataObjectFortranWriter.WriteObjectToBuffer(ABuffer: TCustomStream; AObject: TObject);
begin
  with TMyDataObject(AObject) do
  begin
    WriteToBuffer(ABuffer, A);
    WriteToBuffer(ABuffer, B);
    WriteToBuffer(ABuffer, C);
  end;
end;

initialization
  TMyDataObjectFortranWriter.Register;

finalization
  TMyDataObjectFortranWriter.UnRegister;

end.
Delphi-Quellcode:
MyObject := nil;
Stream := nil;
Writer := nil;
try
  Stream := TFileStream.Create('MyFortranFile.bin');
  Writer := TFortranWriter.Create(Stream);
  MyObject := TMyDataObject.Create;
  MyObject.A := 1;
  MyObject.B := 2;
  MyObject.C := 3;
  Writer.Write(MyObject);
  MyObject.A := 4;
  MyObject.B := 5;
  MyObject.C := 6;
  Writer.Write(MyObject);
finally
  Writer.Free;
  Stream.Free;
  MyObject.Free;
end;
  Mit Zitat antworten Zitat