{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{              ACIS SAT bin to text converter class          }
{                                                            }
{         Copyright (c) 2012-2013 SoftGold software company  }
{                                                            }
{************************************************************}
{$INCLUDE SGDXF.INC}

unit sgSATBinToTextConv;

interface

uses
  {$IFNDEF SGDEL_6}Windows, {$ENDIF}SysUtils, Classes, sgConsts, sgFunction, Math
{$IFDEF SGDEL_XE2}
  ,System.Types
{$ENDIF}
  ;

type
  TsgSATBinToTxtConv = class
  private
    FBinFile: TMemoryStream;
    FDelimiter: Char;
    FEofStr: Char;
    FTextFile: TStringList;
    function Eof: Boolean;
    function FindBody: Boolean;
    function GetByte: Byte;
    procedure GetBytes(var Buffer; Count: Integer);
    function GetFloat: Single;
    function GetDouble: Double;
    function GetLong: Integer;
    function GetString(SizeLen: Integer = 1; AAddLen: Boolean = False): string;
    function GetWord: Word;
    function GetText: string;
    function GetSatString(const Index: Integer): string;
    function GetSatStringCount: Integer;
    function ProcessStr: string;
  public
    constructor Create;
    constructor CreateFromMemory(Mem: Pointer; Size: Integer);
    destructor Destroy; override;
    procedure Clear;
    function Convert(const Delimiter, EofStr: Char): Boolean;
    procedure Init(Mem: Pointer; Size: Integer);
    property SatString[const Index: Integer]: string read GetSatString;
    property SatStringCount: Integer read GetSatStringCount;
    property SatText: string read GetText;
  end;

implementation

{ TsgSATBinToTxtConv }

procedure TsgSATBinToTxtConv.Clear;
begin
  if FTextFile <> nil then
    FTextFile.Clear;
  if FBinFile <> nil then
    FBinFile.Clear;
end;

function TsgSATBinToTxtConv.Convert(const Delimiter, EofStr: Char): Boolean;
var
  S: string;

begin
  Result := False;
  if (FBinFile = nil) or (FBinFile.Size = 0) or (FTextFile = nil) or (not FindBody) then Exit;
  FTextFile.Clear;
  FEofStr := EofStr;
  FDelimiter := Delimiter;
  while not Eof do
  begin
    S := ProcessStr;
//    if S <> '' then
    FTextFile.Add(S);
  end;
  Result := FTextFile.Text <> '';
  if Result then
    FTextFile.Insert(0, sSatDefHeaderString);
end;

constructor TsgSATBinToTxtConv.Create;
begin
  FTextFile := nil;
  FBinFile := nil;
end;

constructor TsgSATBinToTxtConv.CreateFromMemory(Mem: Pointer; Size: Integer);
begin
  Create;
  Init(Mem, Size);
end;

destructor TsgSATBinToTxtConv.Destroy;
begin
  FTextFile.Free;
  FBinFile.Free;
  inherited Destroy;
end;

function TsgSATBinToTxtConv.Eof: Boolean;
begin
  Result := FBinFile.Position = FBinFile.Size;
end;

function TsgSATBinToTxtConv.FindBody: Boolean;
var
  vFoundAddress: TsgNativeUInt;
  vLen: Integer;
begin
  vLen := Length(AnsiString(sSatBody));
  Result := StrPosLen(PByte(FBinFile.Memory), PByte(PAnsiChar(AnsiString(sSatBody))),
    FBinFile.Size, vLen, vFoundAddress) <> nil;
  if Result then
    FBinFile.Position := vFoundAddress - 2;
end;

function TsgSATBinToTxtConv.GetByte: Byte;
begin
  GetBytes(Result, 1);
end;

procedure TsgSATBinToTxtConv.GetBytes(var Buffer; Count: Integer);
begin
  if FBinFile.Read(Buffer, Count) <> Count then
    FillChar(Buffer, Count, 0);
end;

function TsgSATBinToTxtConv.GetDouble: Double;
begin
  GetBytes(Result, 8);
end;

function TsgSATBinToTxtConv.GetFloat: Single;
begin
  GetBytes(Result, 4);
end;

function TsgSATBinToTxtConv.GetLong: Integer;
begin
  GetBytes(Result, 4);
end;

function TsgSATBinToTxtConv.GetSatString(const Index: Integer): string;
begin
  if (FTextFile <> nil) and (Index >= 0) and (Index < FTextFile.Count) then
    Result := FTextFile[Index]
  else
    Result := '';
end;

function TsgSATBinToTxtConv.GetSatStringCount: Integer;
begin
  if FTextFile <> nil then
    Result := FTextFile.Count
  else
    Result := 0;
end;

function TsgSATBinToTxtConv.GetString(SizeLen: Integer = 1;
  AAddLen: Boolean = False): string;
var
  vAnsiStr: AnsiString;
  vLen: Byte;
begin
  Result := '';
  case SizeLen of
    2: vLen := GetWord;
    4: vLen := GetLong;
  else
    vLen := GetByte;
  end;

  if vLen = 0 then Exit;
  SetLength(vAnsiStr, vLen);
  GetBytes(vAnsiStr[1], vLen);
  if AAddLen then
    Result := IntToStr(vLen)+ ' ';
  Result := Result + string(vAnsiStr);
end;

function TsgSATBinToTxtConv.GetText: string;
begin
  Result := '';
  if FTextFile <> nil then
    Result := FTextFile.Text;
end;

function TsgSATBinToTxtConv.GetWord: Word;
begin
  GetBytes(Result, 2);
end;

procedure TsgSATBinToTxtConv.Init(Mem: Pointer; Size: Integer);
begin
  if FTextFile = nil then
    FTextFile := TStringList.Create;
  FEofStr := sSatEofStr;
  FDelimiter := ' ';
  if FBinFile = nil then
    FBinFile := TMemoryStream.Create;
  Clear;
  if IsSatBinaryFile(Mem, Size) then
  begin
    FBinFile.Write(Mem^, Size);
    FBinFile.Position := 0;
  end;
end;

function TsgSATBinToTxtConv.ProcessStr: string;
var
  I, vValInt: Integer;
  vCode: Byte;
  vRes, S: string;
  vIsIntCurve: Boolean;


  procedure AddToResult(const S: string; ANeedAdd: Boolean = True);
  var
    vAddStr: string;
  begin
    if {(Result = '') or }(not ANeedAdd) then
      vAddStr := ''
    else
      vAddStr := FDelimiter;
    vRes := vRes + S + vAddStr;
  end;


begin
  vRes := '';
  vIsIntCurve := False;
  while True do
  begin
    vCode := GetByte;
    if Eof then Break;
    case vCode of
      cntSatBinTagChar:
        AddToResult(IntToStr(GetByte));
      cntSatBinTagShort:
        AddToResult(IntToStr(GetWord));
      cntSatBinTagLong:
        AddToResult(IntToStr(GetLong));
      cntSatBinTagFloat:
        AddToResult(DoubleToStr(GetFloat, cnstSAT_DS));
      cntSatBinTagDouble:
        AddToResult(DoubleToStr(GetDouble, cnstSAT_DS));
      cntSatBinTagPointer:
        AddToResult(sSatRecNumPtr + IntToStr(GetLong));
      cntSatBinTagStringIdent:
        AddToResult(GetString);
      cntSatBinTagStr:
        AddToResult(GetString(1,True));
      cntSatBinTagSubident:
        begin
          S := GetString;
          vIsIntCurve := S = sSatIntcurveWord;
          AddToResult(S + sSatSubident, False);
        end;
      cntSatBinTagPosition, cntSatBinTagVector:
        begin
          for I := 1 to 3 do
            AddToResult(DoubleToStr(GetDouble, cnstSAT_DS));
        end;
      cntSatBinTagTerminator:
        begin
          AddToResult(FEofStr);
          Break;
        end;
      cntSatBinTagLogicalFalse:
        AddToResult(sSatForward);
      cntSatBinTagLogicalTrue:
        AddToResult(sSatReversed);
      cntSatBinTagStrWordSized:
        AddToResult(GetString(2));
      cntSatBinTagStrLongSized:
        AddToResult(GetString(4));
      cntSatBinTagSubtypeStart:
        AddToResult(sSatSubtypeStart);
      cntSatBinTagSubtypeEnd:
        AddToResult(sSatSubtypeEnd);
      cntSatBinTagEnumChar:
        begin
          vValInt := GetLong;
          case vValInt of
            0: if vIsIntCurve then
                 S := sSatFull
               else
                 S := sSatOpen;
            2: S := sSatPeriodic;
          end;
          vIsIntCurve := False;
          AddToResult(S);
        end;
    else
      GetByte;
    end;
  end;
  Result := vRes;
end;

end.
