
//////////////////////////////////////////////////
//  Oracle Data Access Components
//  Copyright © 1998-2014 Devart. All right reserved.
//  OCINumber
//////////////////////////////////////////////////

{$IFNDEF CLR}
{$I Odac.inc}
unit OraNumberUni;
{$ENDIF}

interface

uses
  SysUtils,
  CRTypes,
{$IFNDEF UNIDACPRO}
  OraCall;
{$ELSE}
  OraCallUni;
{$ENDIF}

type
  TOCINumberValue = {$IFDEF CLR}TBytes{$ELSE}array[0..22] of byte{$ENDIF};
  TOCIBCDValue = {$IFDEF CLR}TBytes{$ELSE}array[0..34] of byte{$ENDIF};

  TOCINumber = class
  public
    //class function Assign(err: pOCIError; const from: pTOCINumber; tonum: pTOCINumber): sword;

    class function Compare(const number1: TBytes; const number2: TBytes): sword;

    class function FromInt(Value: int64; IntLength: uword; SignFlag: uword): TBytes;
    class function ToInt(const Value: TBytes; IntLength: uword; SignFlag: uword): int64;

    class function FromReal(Value: double; RealLength: uword): TBytes;
    class function ToReal(const Value: TBytes; RealLength: uword): double;

    class function FromBCD(Value: TBytes; RealLength: uword): TBytes;
    class procedure ToBCD(const number: TOCINumberValue; numberLength: uword; var Result: TOCIBCDValue; ResultLength: uword);

    class function Parse(const str: string; const fmt: string; var number: TBytes): sword;
    class function ToString(const number: TBytes; const fmt: string): string; reintroduce;
  end;

implementation

{ TOCINumber }

class function TOCINumber.Compare(const number1: TBytes; const number2: TBytes): sword;

  function IsZero(const number: TBytes): boolean;
  var
    len: integer;
  begin
    Result := false;
    len := Length(number);
    if (len = 1) and (number[0] = Byte(-128)) then begin
      Result := true;
      Exit;
    end;

    if (len = 2) and (number[0] = Byte(-1)) and (number[0] = 101) then begin
      Result := true;//1/0;  // +INF
      Exit;
    end;

    if (len = 1) and (number[0] = 0) then begin
      Result := true;//-1/0;  // -INF
      Exit;
    end;
  end;
var
  len1, len2: integer;
  i, exponent1, exponent2: integer;
  isPositive1, isPositive2: boolean;
begin
  if IsZero(number1) and IsZero(number2) then begin
    Result := 0;
    Exit;
  end;

  isPositive1 := (number1[0] and $ffffff80) <> 0;// is positive
  isPositive2 := (number2[0] and $ffffff80) <> 0;// is positive

  // sign
  if isPositive1 <> isPositive2 then begin
    if isPositive2 then // is positive
      Result := -1
    else
      Result := 1;
    Exit;
  end;

// mantissa convert

  len1 := Length(number1);
  if isPositive1 then // is positive
    exponent1 := Integer(number1[0] and $ffffff7f) - 65
  else begin
    if (len1 - 1 <> 20) or (number1[len1 - 1] = 102) then
      Dec(len1);
    exponent1 := Integer(not number1[0] and $ffffff7f) - 65;
  end;

  len2 := Length(number2);
  if isPositive2 then // is positive
    exponent2 := Integer(number2[0] and $ffffff7f) - 65
  else begin
    if (len2 - 1 <> 20) or (number2[len2 - 1] = 102) then
      Dec(len2);
    exponent2 := Integer(not number2[0] and $ffffff7f) - 65;
  end;

  if exponent2 > exponent1 then begin
    if isPositive1 then
      Result := -1
    else
      Result := 1;
    Exit;
  end
  else if exponent2 < exponent1 then begin
    if isPositive1 then
      Result := 1
    else
      Result := -1;
    Exit;
  end;

  // digits
  i := 1;
  while (i < len1) and (i < len2) do begin
    if (number1[i] > number2[i]) then begin
      Result := 1;
      Exit;
    end
    else if (number1[i] < number2[i]) then begin
      Result := -1;
      Exit;
    end;
    Inc(i);
  end;

  // last digits
  if len1 > len2 then begin
    if isPositive1 then
      Result := 1
    else
      Result := -1;
    Exit;
  end
  else if len1 < len2 then begin
    if isPositive1 then
      Result := -1
    else
      Result := 1;
    Exit;
  end;

  Result := 0;
end;

class function TOCINumber.FromInt(Value: int64; IntLength: uword; SignFlag: uword): TBytes;
var
  mantissa: array[0..19] of byte;
  temp: array[0..19] of byte;
  flag: integer;
  exponent: integer;
  length: byte;
  i, j: integer;
begin
  if Value = 0 then begin
    SetLength(Result, 1);
    Result[0] := Byte(-128);
    Exit;
  end;

  if Value >= 0 then
    flag := 1
  else
    flag := -1;

  i := 0;
  while Value <> 0 do begin
    temp[i] := Abs(Value mod 100);
    Value := Value div 100;
    Inc(i);
  end;
  Dec(i);

  length := 0;
  exponent := i;
  j := exponent;
  while length <= exponent do begin
    mantissa[length] := temp[j];
    Inc(length);
    Dec(j)
  end;

  while i > 0 do begin
    if mantissa[i] <> 0 then
      break;
    Dec(i);
    Dec(length);
  end;

// mantissa convert

  if flag >= 0 then begin  // positive
    SetLength(Result, length + 1);
    Result[0] := Byte(exponent + 128 + 65);
    for i := 0 to length - 1 do
      Result[i + 1] := mantissa[i] + 1;
  end
  else begin
    if length < 20 then
      SetLength(Result, length + 2)
    else
      SetLength(Result, length + 1);
    Result[0] := not Byte(exponent + 128 + 65);
    i := 0;
    while i < length do begin
      Result[i + 1] := 101 - mantissa[i];
      Inc(i);
    end;

    if i < 20 then
      Result[i + 1] := 102;
  end;
end;

class function TOCINumber.ToInt(const Value: TBytes; IntLength: uword; SignFlag: uword): int64;
var
  mantissa: array[0..30] of byte;
  convDigs: integer;
  exponent: integer;
  len: byte;
  i: integer;
begin
  if (Length(Value) = 1) and (Value[0] = Byte(-128)) then begin
    Result := 0;
    Exit;
  end;

  if (Length(Value) = 2) and (Value[0] = Byte(-1)) and (Value[0] = 101) then begin
    Result := 0;  // +INF
    Exit;
  end;

  if (Length(Value) = 1) and (Value[0] = 0) then begin
    Result := 0;  // -INF
    Exit;
  end;

// mantissa convert

  len := Length(Value);
  if (Value[0] and $ffffff80) <> 0 then begin  // is positive
    mantissa[0] := Byte(Integer(Value[0] and $ffffff7f) - 65);
    for i := 1 to len - 1 do
      mantissa[i] := Byte(Integer(Value[i]) - 1);
  end
  else begin
    if (len - 1 <> 20) or (Value[len - 1] = 102) then
      Dec(len);
    mantissa[0] := Byte(Integer(not Value[0] and $ffffff7f) - 65);
    for i := 1 to len - 1 do
      mantissa[i] := Byte(101 - Integer(Value[i]));
  end;
  exponent := ShortInt(mantissa[0]);
  Dec(len);

// decode

  Result := 0;
  if len <= exponent + 1 then
    convDigs := len
  else
    convDigs := exponent + 1;

  for i := 0 to convDigs - 1 do
    Result := Result * 100 + mantissa[i + 1];

  for i := exponent - len downto 0 do
    Result := Result * 100;

  if Value[0] and $ffffff80 = 0 then  // is not positive
    Result := -Result;
end;

{
d -     value
i -     exponent
byte0 - digits
j -     oIndex
byte1 - digit
abyte0 - mantissa}

class function TOCINumber.FromReal(Value: double; RealLength: uword): TBytes;
const
  powerTable: array [0..7,0..2] of double = (
    (128, 1E+256, 1E-256),
    (64, 1E+128, 1E-128),
    (32, 1E+064, 1E-064),
    (16, 1E+032, 1E-032),
    (8, 1E+016, 1E-016),
    (4, 1E+008, 1E-008),
    (2, 10000, 0.0001),
    (1, 100, 0.01));
var
  mantissa: array[0..19] of byte;
  flag: integer;
  exponent: integer;
  fullDig: boolean;
  digits: byte;
  oIndex: integer;
  digit: byte;
  length: byte;
  i: integer;
begin
  if Value = 0 then begin  // Zero
    SetLength(Result, 1);
    Result[0] := Byte(-128);
    Exit;
  end;
  if Value = 1/0 then begin  // +INF
    SetLength(Result, 2);
    Result[0] := Byte(-1);
    Result[1] := 101;
    Exit;
  end;
  if Value = -1/0 then begin  // -INF
    SetLength(Result, 1);
    Result[0] := 0;
    Exit;
  end;

  if Value > 0 then
    flag := 1
  else
    flag := -1;
  Value := Abs(Value);
  exponent := 0;
  if Value < 1 then begin
    for i := 0 to 7 do
      if powerTable[i][2] >= Value then begin
        exponent := exponent - Trunc(powerTable[i][0]);
        Value := Value * powerTable[i][1];
      end;

    if Value < 1 then begin
      Dec(exponent);
      Value := Value * 100;
    end;
  end
  else begin
    for i := 0 to 7 do
      if powerTable[i][1] <= Value then begin
        exponent := exponent + Trunc(powerTable[i][0]);
        Value := Value * powerTable[i][2];
      end;
  end;

  fullDig := Value < 10;
  digits := 8;
  oIndex := 0;
  digit := Trunc(Value); // (byte)(int)

  while oIndex < digits do begin
    mantissa[oIndex] := digit;
    Value := (Value - digit) * 100;
    digit := Trunc(Value);
    Inc(oIndex);
  end;

  oIndex := 7;
  if fullDig then begin
    if digit >= 50 then
      Inc(mantissa[oIndex]);
  end
  else begin
    mantissa[oIndex] := Trunc(((mantissa[oIndex] + 5) div 10) * 10);
  end;

  while mantissa[oIndex] = 100 do  begin
    if oIndex = 0 then begin
      Inc(exponent);
      mantissa[oIndex] := 1;
      break;
    end;
    mantissa[oIndex] := 0;
    Dec(oIndex);
    Inc(mantissa[oIndex]);
  end;

  oIndex := 7;
  while (oIndex <> 0) and (mantissa[oIndex] = 0) do begin
    Dec(digits);
    Dec(oIndex);
  end;

  length := digits;

// mantissa convert

  if flag >= 0 then begin  // positive
    SetLength(Result, length + 1);
    Result[0] := Byte(exponent + 128 + 65);
    for i := 0 to length - 1 do
      Result[i + 1] := mantissa[i] + 1;
  end
  else begin
    if length < 20 then
      SetLength(Result, length + 2)
    else
      SetLength(Result, length + 1);
    Result[0] := not Byte(exponent + 128 + 65);
    i := 0;
    while i < length do begin
      Result[i + 1] := 101 - mantissa[i];
      Inc(i);
    end;

    if i < 20 then
      Result[i + 1] := 102;
  end;
end;

class function TOCINumber.ToReal(const Value: TBytes; RealLength: uword): double;
var
  mantissa: array[0..30] of byte;
  exponent: integer;
  len: byte;
  i, j: integer;
  xpon: integer;
begin
  len := Length(Value);
  if (len = 1) and (Value[0] = Byte(-128)) then begin
    Result := 0;
    Exit;
  end;

  if (len = 2) and (Value[0] = Byte(-1)) and (Value[0] = 101) then begin
    Result := 1/0;  // +INF
    Exit;
  end;

  if (len = 1) and (Value[0] = 0) then begin
    Result := -1/0;  // -INF
    Exit;
  end;

// mantissa convert

  if (Value[0] and $ffffff80) <> 0 then begin  // is positive
    mantissa[0] := Byte(Integer(Value[0] and $ffffff7f) - 65);
    for i := 1 to len - 1 do
      mantissa[i] := Byte(Integer(Value[i]) - 1);
  end
  else begin
    if (len - 1 <> 20) or (Value[len - 1] = 102) then
      Dec(len);
    mantissa[0] := Byte(Integer(not Value[0] and $ffffff7f) - 65);
    for i := 1 to len - 1 do
      mantissa[i] := Byte(101 - Integer(Value[i]));
  end;
  exponent := ShortInt(mantissa[0]);

  Result := 0;
  i := 1;
  j := 0;
  xpon := exponent + 1;
  while (i < len) and (j < 15) do begin
    Result := Result * 100 + mantissa[i];
    Inc(i);
    Inc(j);
    Dec(xpon);
  end;

  if (i < len) and (mantissa[i] >= 50) then
    Result := Result + 1;
  if (xpon > 0) then
    while xpon > 0 do begin
      Result := Result * 100;
      Dec(xpon);
    end
  else
    while xpon < 0 do begin
      Result := Result / 100;
      Inc(xpon);
    end;

  if Value[0] and $ffffff80 = 0 then  // is not positive
    Result := -Result;
end;

class function TOCINumber.Parse(const str: string; const fmt: string; var number: TBytes): sword;
const
  CharToNum: array[$30..$39] of Byte = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9);
var
  i, ind, exponent: Integer;
  IsFirstDigit, IsPositive, flag: Boolean;
  state, DigitInd: Integer;
  ch: Char;
  bytesCount, digInd, nonZeroStart, nonZeroEnd, pointInd: integer;
begin
  ind := 1;
  while ind <= Length(str) do
    if str[ind] = ' ' then
      Inc(ind)
    else
      break;

  digInd := 0;
  nonZeroStart := -1;
  nonZeroEnd := -1;
  pointInd := -1;
  for i := ind to Length(str) do begin
    ch := str[i];
    if ch = {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator{$IFDEF CLR}[1]{$ENDIF} then begin
      pointInd := digInd;
      continue;
    end;
    if (ch >= '0') and (ch <= '9') then begin
      Inc(digInd);
      if ch <> '0' then begin
        if nonZeroStart = -1 then
          nonZeroStart := digInd;
        if nonZeroStart <> -1 then
          nonZeroEnd := digInd;
      end;
    end;
  end;
  if pointInd = -1 then
    pointInd := digInd;

  Result := 0;
  if nonZeroEnd = -1 then begin  // Zero
    SetLength(number, 1);
    number[0] := Byte(-128);
    Exit;
  end;

  if pointInd >= nonZeroStart then
    exponent := (pointInd - nonZeroStart) div 2
  else
    exponent := -(nonZeroStart - pointInd - 1) div 2 - 1;

  IsFirstDigit := ((nonZeroStart xor pointInd) mod 2) <> 0;

  bytesCount := nonZeroEnd - nonZeroStart + 2;
  if not IsFirstDigit then
    Inc(bytesCount);
  bytesCount := bytesCount div 2;

  IsPositive := true;
  flag := false;
  // sign
  if ind <= Length(str) then begin
    ch := str[ind];
    if ch = '-' then begin
      IsPositive := false;
      Inc(Ind);
    end
    else if ch = '+' then begin
      IsPositive := true;
      Inc(Ind);
    end
    else if ((ch < '0') or (ch > '9')) and (ch <> '+') and (char(ch) <> {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator{$IFDEF CLR}[1]{$ENDIF}) then
      Result := 1;
  end;

  if IsPositive then begin  // positive
    SetLength(number, bytesCount + 1);
    number[0] := Byte(exponent + 128 + 65);
  end
  else begin
    if bytesCount < 20 then begin
      SetLength(number, bytesCount + 2);
      number[bytesCount + 1] := 102;
    end
    else
      SetLength(number, bytesCount + 1);
    number[0] := not Byte(exponent + 128 + 65);
  end;

  DigitInd := 1;
  state := 1;
  number[1] := 0;
  if bytesCount > 20 then
    Result := 1;
  while (ind <= Length(str)) and (Result = 0) and (DigitInd <= bytesCount) do begin
    ch := str[ind];
    if (state = 1) and (char(ch) = {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator{$IFDEF CLR}[1]{$ENDIF}) then begin
      Inc(state);
    end
    else if (ch >= '0') and (ch <= '9') then begin
      if flag or (ch <> '0') then begin
        flag := true;
        if IsFirstDigit then
          number[DigitInd] := CharToNum[Byte(ch)] * 10
        else begin
          number[DigitInd] := number[DigitInd] + 1 + CharToNum[Byte(ch)];
          Inc(DigitInd);
        end;
        IsFirstDigit := not IsFirstDigit;
      end;
    end
    else if (ch = ' ') then
      break
    else
      Result := 1;
    Inc(ind);
  end;
  if Result <> 0 then
    raise Exception.Create(Format('''%s'' is not a valid Oracle Number value', [str]));
  if not IsFirstDigit then
    number[DigitInd] := number[DigitInd] + 1;

  if not IsPositive then begin  // positive
    for i := 1 to bytesCount do
      number[i] := 102 - number[i];
  end;
end;

class function TOCINumber.ToString(const number: TBytes; const fmt: string): string;
var
  mantissa: array[0..30] of byte;
  exponent: integer;
  len: byte;
  i, DotStrPos: integer;
  xpon: integer;
{$IFDEF CLR}
  s: string;
{$ELSE}
  j: integer;
{$ENDIF}
  //Num: double;
begin
  //Num := ToReal(number, sizeof(Double));
  //Result := FloatToStr(Num);
  //exit;

  len := Length(number);
  if (len = 1) and (number[0] = Byte(-128)) then begin
    Result := '0';
    Exit;
  end;

  if (len = 2) and (number[0] = Byte(-1)) and (number[0] = 101) then begin
    Result := '0';//1/0;  // +INF
    Exit;
  end;

  if (len = 1) and (number[0] = 0) then begin
    Result := '0';//-1/0;  // -INF
    Exit;
  end;

// mantissa convert

  if (number[0] and $ffffff80) <> 0 then begin  // is positive
    mantissa[0] := Byte(Integer(number[0] and $ffffff7f) - 65);
    for i := 1 to len - 1 do
      mantissa[i] := Byte(Integer(number[i]) - 1);
  end
  else begin
    if (len - 1 <> 20) or (number[len - 1] = 102) then
      Dec(len);
    mantissa[0] := Byte(Integer(not number[0] and $ffffff7f) - 65);
    for i := 1 to len - 1 do
      mantissa[i] := Byte(101 - Integer(number[i]));
  end;
  exponent := ShortInt(mantissa[0]);

  i := 1;
  xpon := exponent + 1;
{$IFDEF CLR}
  Result := '';
  while (i < len) do begin
    s := IntToStr(mantissa[i]);
    if Length(s) < 2 then
      Result := Result + '0' + s
    else
      Result := Result + s;
    Inc(i);
    Dec(xpon);
  end;
{$ELSE}

  SetLength(Result, (len - i) * 2);
  j := 1;
  while (i < len) do begin
    if mantissa[i] < 10 then begin
      Result[j] := '0';
      Result[j + 1] := Char($30 + mantissa[i]);
    end
    else begin
      Result[j] := Chr($30 + mantissa[i] div 10);
      Result[j + 1] := Char($30 + mantissa[i] mod 10);
    end;
    Inc(j, 2);
    Inc(i);
    Dec(xpon);
  end;
{$ENDIF}

  DotStrPos := Length(Result) + xpon * 2 + 1;
  if (xpon >= 0) then begin                      // 12345v>=00.
    while xpon > 0 do begin
      Result := Result + '00';
      Dec(xpon);
    end
  end
  else begin
    if DotStrPos > 1 then begin                    //  v>12.345<
      Insert({$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator, Result, DotStrPos)
    end
    else begin
      while DotStrPos < 1 do begin                //.00<=v12345
        Result := '0' + Result;
        Inc(DotStrPos);
      end;
      Result := '0' + {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator + Result;
      DotStrPos := 2;
    end;
  end;

  if (Length(Result) > 1) and (DotStrPos < Length(Result)) then begin
    while Result[Length(Result)] = '0' do
      Delete(Result, Length(Result), 1);
  end;
  if (Length(Result) > 1) then begin
    while (DotStrPos > 1) and (Result[1] = '0') do
      Delete(Result, 1, 1);
  end;

  {if ThousandSeparator <> #0 then begin
    i := DotStrPos + 4;
    while i <= Length(Result) do begin
      Insert(ThousandSeparator, Result, i);
      Inc(i, 4);
    end;
    i := DotStrPos - 3;
    while i > 1 do begin
      Insert(ThousandSeparator, Result, i);
      Dec(i, 3);
    end;
  end;}

  if number[0] and $ffffff80 = 0 then  // is not positive
    Result := '-' + Result;
end;

class function TOCINumber.FromBCD(Value: TBytes; RealLength: uword): TBytes;
var
  i, exponent: Integer;
  IsFirstDigit, IsFirstDigitBCD, IsPositive: Boolean;
  NumberInd, BCDInd: Integer;
  b: byte;
  bytesCount: integer;
  OldPrecision, Precision, Places: integer;
begin
  if (Value[0] = 0) or (Value[0] > 64) or ((Value[1] and $40) > 0) then begin  // Zero
    SetLength(Result, 1);
    Result[0] := Byte(-128);
    Exit;
  end;
  Precision := Value[0];
  IsPositive := (Value[1] and $80) = 0;
  Places := Value[1] and $3f;

  // last nulls
  i := (Precision + 1) div 2 + 1;
  repeat
   if Value[i] <> 0 then begin
     if (Precision mod 2) = 0 then begin
       if (Value[Precision div 2 + 1] and $f) = 0 then begin //last digit is null
         Dec(Precision);
         Dec(Places);
       end;
     end
     else begin
       if (Value[Precision div 2 + 1] and $f0) = 0 then begin //first digit is null
         Dec(Precision);
         Dec(Places);
       end;
     end;
     break;
   end;
   Dec(Precision, 2);
   Dec(Places, 2);
   Dec(i);
  until i <= 1;

  BCDInd := 2;
  IsFirstDigitBCD := true;
  // first nulls
  OldPrecision := (Precision + 1) div 2 + 1;
  for i := 2 to OldPrecision do begin
   if Value[i] <> 0 then begin
     if (Value[i] and $f0) = 0 then begin
       IsFirstDigitBCD := false;
       Dec(Precision);
     end;
     break;
   end;
   Inc(BCDInd);
   Dec(Precision, 2);
  end;

  if Precision = 0 then begin
    SetLength(Result, 1);
    Result[0] := Byte(-128);
    Exit;
  end;

  IsFirstDigit := ((Precision - Places) mod 2) = 0;

  if Precision - Places >= 0 then
    exponent := (Precision - Places + 1) div 2 - 1
  else
    exponent := (Precision - Places) div 2 - 1;

  bytesCount := (Precision + 1 + ((Precision - Places) and 1)) div 2;

  if IsPositive then begin  // positive
    SetLength(Result, bytesCount + 1);
    Result[0] := Byte(exponent + 128 + 65);
  end
  else begin
    if bytesCount < 20 then begin
      SetLength(Result, bytesCount + 2);
      Result[bytesCount + 1] := 102;
    end
    else
      SetLength(Result, bytesCount + 1);
    Result[0] := not Byte(exponent + 128 + 65);
  end;

  NumberInd := 1;
  Result[1] := 0;
  for i := 1 to Precision do begin
    if IsFirstDigitBCD then
      b := (Value[BCDInd] and $f0) shr 4
    else begin
      b := Value[BCDInd] and $f;
      Inc(BCDInd);
    end;
    IsFirstDigitBCD := not IsFirstDigitBCD;

    if IsFirstDigit then
      Result[NumberInd] := b * 10
    else begin
      Result[NumberInd] := Result[NumberInd] + b + 1;
      Inc(NumberInd);
    end;
    IsFirstDigit := not IsFirstDigit;
  end;
  {if Result <> 0 then
    raise Exception.Create(Format('''%s'' is not a valid Oracle Number value', [str]));}
  if not IsFirstDigit then
    Result[NumberInd] := Result[NumberInd] + 1;

  if not IsPositive then begin  // positive
    for i := 1 to bytesCount do
      Result[i] := 102 - Result[i];
  end;
end;

class procedure TOCINumber.ToBCD(const number: TOCINumberValue; numberLength: uword; var Result: TOCIBCDValue; ResultLength: uword);
var
  IsPositive, IsFirstDigit, IsFirstDigitBCD: Boolean;
  BCDInd: Integer;
  exponent: integer;
  len, b: byte;
  i, Precision: integer;
begin
  len := numberLength;
  if (len = 1) and (number[0] = Byte(-128)) then begin
    Result[0] := 0;
    Result[1] := 0;
    Exit;
  end;

  if (len = 2) and (number[0] = Byte(-1)) and (number[0] = 101) then begin
    Result[0] := 0;
    Result[1] := 0;//1/0;  // +INF
    Exit;
  end;

  if (len = 1) and (number[0] = 0) then begin
    Result[0] := 0;
    Result[1] := 0;//-1/0;  // -INF
    Exit;
  end;

// mantissa convert

  if (number[0] and $ffffff80) <> 0 then begin  // is positive
    IsPositive := true;
    Result[1] := 0;
    exponent := ShortInt((number[0] and $ffffff7f) - 65);
  end
  else begin
    IsPositive := false;
    Result[1] := $80;
    if (len - 1 <> 20) or (number[len - 1] = 102) then
      Dec(len);
    exponent := ShortInt((not number[0] and $ffffff7f) - 65);
  end;
  exponent := exponent * 2 + 1;

  // copy digits
  if 2 <= len then begin
    if IsPositive then
      IsFirstDigit := ((Integer(number[1]) - 1) div 10) <> 0
    else
      IsFirstDigit := ((101 - Integer(number[1])) div 10) <> 0;
    IsFirstDigitBCD := true;
    BCDInd := 2 ;

    Precision := (len - 1) * 2;
    if not IsFirstDigit then
      Dec(Precision)
    else
      Inc(exponent);

    // correct precision
    if IsPositive then
      b := Byte(Integer(number[len - 1]) - 1)
    else
      b := Byte(101 - Integer(number[len - 1]));
    if (b mod 10) = 0 then
      Dec(Precision);

    // for 0,<00..0>123 numbers
    if exponent < 0 then begin
      if Precision - exponent > 64 then
        raise Exception.Create('Cannot convert to Number to BCD');
      BCDInd := 2 - exponent div 2;
      IsFirstDigitBCD := (exponent mod 2) = 0;
      Precision := Precision - exponent;
      exponent := 0;
      for i := 2 to BCDInd do
        Result[i] := 0;
    end;

    i := 1;
    repeat
      if IsPositive then
        b := Byte(Integer(number[i]) - 1)
      else
        b := Byte(101 - Integer(number[i]));

      // first digit from number
      if IsFirstDigit then begin
        if IsFirstDigitBCD then
          Result[BCDInd] := (b div 10) shl 4
        else begin
          Result[BCDInd] := Result[BCDInd] + (b div 10);
          Inc(BCDInd);
        end;
        IsFirstDigitBCD := not IsFirstDigitBCD;
      end
      else
        IsFirstDigit := true;

      // second digit from number
      if BCDInd <= 33 then begin
        if IsFirstDigitBCD then
          Result[BCDInd] := (b mod 10) shl 4
        else begin
          Result[BCDInd] := Result[BCDInd] + (b mod 10);
          Inc(BCDInd);
        end;
      end;
      IsFirstDigitBCD := not IsFirstDigitBCD;

      Inc(i);
    until i >= len;
    if (b mod 10) = 0 then begin
      if IsFirstDigitBCD then
        Dec(BCDInd);
      IsFirstDigitBCD := not IsFirstDigitBCD;
    end;
  end
  else begin
    Precision := 0;
    IsFirstDigitBCD := false;
    BCDInd := 0;
  end;

  exponent := Precision - exponent;
  while exponent < 0 do begin
    if BCDInd >= 34 then
      raise Exception.Create('Cannot convert to Number to BCD');
    if IsFirstDigitBCD then
      Result[BCDInd] := 0
    else begin
      Inc(BCDInd);
    end;
    IsFirstDigitBCD := not IsFirstDigitBCD;
    Inc(Precision);
    Inc(exponent);
  end;
  Result[0] := Precision;
  Result[1] := Result[1] or exponent;
end;

end.
