Einlesen einer FORTRAN Binärdatei mit Delphi

[p80286]

Zitat von Uwe Raabe:

Das sieht mir aber nicht nach einer generellen Lösung aus. Zeig doch mal den Hexdump der gesamten Fortran-Datei oder hänge sie hier an.

Gruß
K-H

[Tenobaal]

Hier eine Funktion die eine Double, zwei Integer Zahlen und ein Array der Länge 3 vom Datentyp Char in eine Binärdatei schreibt.
Inhalt der Binärdatei aus dem Hexeditor:

Code:

13000000000000F03F020000000200000041424313

Programmcode:

Code:

      SUBROUTINE OUTNET
C**********************************************************************
C
C
C
C IMPLICIT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      COMMON /STEUER/ IERR,LIN,KPER,NPRINT,MPRINT,MAXP,MAXT,IRECH,IB2,
     ,                NSPG,NROT1,NROT2,NSTROM
      COMMON /TEXTE/  TITEL
      COMMON /NETZP/  NPMAX,NPUNKT,NPVAR,NZMAX,NZELLE,NSMAX,NSTR,MMAX
      COMMON /NETZD/  X(10000),Y(10000),A(10000),NUE(20000),SD(20000),
     ,                GAM(20000),
     ,                D(20000),GK(3,20000),NACHBZ(60000),ENDZ(10000),
     ,                NPER(10000),MGEB(20000),
     ,                ECKP(3,20000),RANDZ(3,20000),RANDS(3,20000),
     ,                AP(30000),EP(30000),GL(30000),GR(30000),
     ,                RAND(30000),ZL(30000),ZR(30000)
      COMMON /KONTUR/ GECKP(3,4000),IGECKP
      COMMON /IODEF / VERSIO,NTEST,IKART,NLIST,ND1,INET,NNET,NPLOT,
     ,                NUEPL

      DOUBLE PRECISION    NUE,GAM
      COMPLEX*16 A,SD,AComplex
      CHARACTER*3 TITEL
      REAL*8 VERSIO
      INTEGER*4 NACHBZ,ENDZ,NPER,MGEB,ECKP,RANDZ,RANDS
      INTEGER*4 AP,EP,GL,GR,RAND,ZL,ZR

      ADOUBLE=1.0 !Double 64-Bit
      NINTEGER=2  !Integer 32-Bit
      TITEL='ABC' ! Array of Char
      
      WRITE (NNET)  ADOUBLE,NINTEGER,NINTEGER,TITEL !Schreibe in Binärdatei
      RETURN
      END

[Uwe Raabe]

Die $13 sind offensichtlich die Länge des Records (19 Zeichen). Warum die am Ende nochmal kommt, weiß ich auch nicht. Mach doch mal eine Datei mit mehreren Datensätzen. (Mit Fortran hatte ich das letzte Mal vor 40 Jahren zu tun...)

[BUG]

Zitat von Uwe Raabe:

Die $13 sind offensichtlich die Länge des Records (19 Zeichen). Warum die am Ende nochmal kommt, weiß ich auch nicht.

Ein Suchergebnis hat Rückwärtsspringen über Records vermutet ... würde Sinn machen.

@tenobaal: Du scheinst den implementierungsabhängigen Unformatted-Mode zu benutzen, insofern wirst du keine Lösung finden, die mit allen Fortran-Compilern kompatibel ist.

[Uwe Raabe]

Zitat von BUG:

Zitat von Uwe Raabe:

Die $13 sind offensichtlich die Länge des Records (19 Zeichen). Warum die am Ende nochmal kommt, weiß ich auch nicht.

Ein Suchergebnis hat Rückwärtsspringen über Records vermutet ... würde Sinn machen.

Das wäre denkbar. Ein ähnliches Format hatte ich schon mal bei Daten für Magnetbänder.

[Mavarik]

Also für mich sieht das ganz und gar nicht nach eine Binärdatei aus...

Schau Dir mal das hier an...

Mavarik

[Blup]

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;

[Mavarik]

Zitat von Tenobaal:

Hier eine Funktion die eine Double, zwei Integer Zahlen und ein Array der Länge 3 vom Datentyp Char in eine Binärdatei schreibt.
Inhalt der Binärdatei aus dem Hexeditor:

Code:

13000000000000F03F020000000200000041424313

OK Formatieren wir das mal so das man es lesen kann...

Code:

13 00 00 00 00 00 00 F0 3F 02 00 00 00 02 00 00 00 41 42 43 13

Lassen wir mal die $13 vor und nach dem Datensatz außer acht...

Dann schreibt diese kleine Delphi Programm das gleiche weg... (Oder liest es ein).
Auch ohne eine Monster-Class dafür zu Programmieren.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
{$A1}

type
  TB = record
         Len1 : byte;
         A : Double;
         C,
         D : Integer;
         S : array[1..3] of AnsiChar;
         Len2 : byte;
       end;

// 13 00 00 00 00 00 00 F0 3F 02 00 00 00 02 00 00 00 41 42 43 13

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    B : TB;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  F : File;
begin
  Assignfile(F,'Test.net');
  rewrite(F,1);
  B.Len1 := $13;
  B.Len2 := $13;
  B.A := 1.0;
  B.C := 2;
  B.D := 2;
  B.S[1] := 'A';
  B.S[2] := 'B';
  B.S[3] := 'C';
  Blockwrite(F,B,Sizeof(B));
  Closefile(F);
end;

end.

Aber das wird trotzdem nicht zielführend sein, da der Text ABC keine längen Informationen hat...
Es sei den, Texte werden mit einem $13 beendet.. Also kein längenbyte und nicht 0 terminiert.
Oder das letzte $13 ist einfach ein CR weil Datei nicht als Bin Datei geöffnet wurde.

Boh... Mach doch mal ein richtiges Beispiel und fülle die Daten mit einem Pattern.

Delphi-Quellcode:

var
  B  : Byte;
  W  : Word;
  L  : Integer;
  S1 : String
  S2 : String;
  N  : Byte;
begin
  B := $55;
  W := $3388;
  L := $11223344;
  S1 := 'Das ist ein cooler Text';
  S2 := 'Noch einer';
  N  := $99;
  ...
end;

In Fortran natürlich und bitte 3x hinter einander weg schreiben... und bitte erst dem Link aus meinen mein Posting #16 lesen.

Mavarik

[Sir Rufo]

Zitat von Mavarik:

Also für mich sieht das ganz und gar nicht nach eine Binärdatei aus...

Schau Dir mal das hier an...

Mavarik

Jede Datei ist eine Binär-Datei. Alles andere sind Unterklassen mit einem vereinbarten Format

[Mavarik]

Zitat von Sir Rufo:

Jede Datei ist eine Binär-Datei. Alles andere sind Unterklassen mit einem vereinbarten Format

Logisch... Solange wir Informationen noch nicht in Bio-neuronalen-Gel Packs abspeichern...

Siehe...

Mavarik