Как преобразовать число с плавающей запятой REAL48 в двойное

Добавление этого как еще один ответ, потому что я наконец понял это. Вот код PHP, который преобразует значения. Его нужно вычислять вручную, потому что PHP не знает, как распаковать Real48 (нестандартный). Объяснение в комментариях ниже.

function BiIntToReal48($f1, $f2){
  $x = str_pad(decbin($f1), 16, "0", STR_PAD_LEFT);
  $y = str_pad(decbin($f2), 32, "0", STR_PAD_LEFT);
  //full Real48 binary string
  $real48 = $y . $x;

  //Real48 format is V = (-1)^s * 1.f * 2^(exp-129)
  // rightmost eight bits are the exponent  (bits 40-->47)
  // subtract 129 to get the final value
  $exp = (bindec(substr($real48, -8)) - 129);

  //Sign bit is leftmost bit (bit[0])
  $sign =$real48[0];

  //Now work through the significand - bits are fractional binary 
  //(1/2s place, 1/4s place, 1/8ths place, etc)
  // bits 1-->39 
  // significand is always 1.fffffffff... etc so start with 1.0
  $sgf = "1.0";

  for ($i = 1; $i <= 39; $i++){
      if ($real48[$i] == 1){
        $sgf = $sgf + pow(2,-$i); 
      }       
  } 
  //final calculation
  $final = pow(-1, $sign) * $sgf * pow(2,$exp);
  return($final);
}
$field_1 = 132;
$field_2 = 805306368;      
$ConvVal = BiIntToReal48($field_1, $field_2);
// ^ gives $ConvVal = 11, qed

Я работаю над этой проблемой около недели, пытаясь разобраться с ней для нашей организации.

Наш финансовый отдел использует IRIS Exchequer, и нам нужно получить расходы. Используя приведенный выше PHP-код, мне удалось заставить его работать в Excel VBA со следующим кодом (включает зависимые функции). Если я не правильно указал ниже, я получил все длинные функции dec to bin с www.sulprobil.com. Если вы скопируете и вставите следующий блок кода в модуль, вы сможете сослаться на мою функцию ExchequerDouble из ячейки.

Прежде чем продолжить, я должен указать на одну ошибку в приведенном выше коде C/PHP. Если вы посмотрите на петли Significand:

C/PHP: Significand = Significand + 2 ^ (-i)
VBA:   Significand = Significand + 2 ^ (1 - i)

Во время тестирования я заметил, что ответы были очень близкими, но часто неправильными. Углубившись глубже, я сузил его до Значимого. Это может быть проблема с переводом кода с одного языка/методологии на другой или может быть просто опечатка, но добавление (1 - i) имеет все значение.

Function ExchequerDouble(Val1 As Integer, Val2 As Long) As Double
    Dim Int2 As String
    Dim Int4 As String
    Dim Real48 As String
    Dim Exponent As String
    Dim Sign As String
    Dim Significand As String

    'Convert each value to binary
    Int2 = LongDec2Bin(Val1, 16, True)
    Int4 = LongDec2Bin(Val2, 32, True)

    'Concatenate the binary strings to produce a 48 bit "Real"
    Real48 = Int4 & Int2

    'Calculate the exponent
    Exponent = LongBin2Dec(Right(Real48, 8)) - 129

    'Calculate the sign
    Sign = Left(Real48, 1)

    'Begin calculation of Significand
    Significand = "1.0"

    For i = 2 To 40
        If Mid(Real48, i, 1) = "1" Then
           Significand = Significand + 2 ^ (1 - i)
        End If
    Next i

    ExchequerDouble = CDbl(((-1) ^ Sign) * Significand * (2 ^ Exponent))
End Function

Function LongDec2Bin(ByVal sDecimal As String, Optional lBits As Long = 32, Optional blZeroize As Boolean = False) As String
    'Transforms decimal number into binary number.
    'Reverse("moc.LiborPlus.www") V0.3 P3 16-Jan-2011

    Dim sDec As String
    Dim sFrac As String
    Dim sD As String 'Internal temp variable to represent decimal
    Dim sB As String
    Dim blNeg As Boolean
    Dim i As Long
    Dim lPosDec As Long
    Dim lLenBinInt As Long

    lPosDec = InStr(sDecimal, Application.DecimalSeparator)

    If lPosDec > 0 Then
        If Left(sDecimal, 1) = "-" Then 'negative fractions later..
            LongDec2Bin = CVErr(xlErrValue)
            Exit Function
        End If

        sDec = Left(sDecimal, lPosDec - 1)
        sFrac = Right(sDecimal, Len(sDecimal) - lPosDec)
        lPosDec = Len(sFrac)
    Else
        sDec = sDecimal
        sFrac = ""
    End If

    sB = ""

    If Left(sDec, 1) = "-" Then
        blNeg = True
        sD = Right(sDec, Len(sDec) - 1)
    Else
        blNeg = False
        sD = sDec
    End If

    Do While Len(sD) > 0
        Select Case Right(sD, 1)
            Case "0", "2", "4", "6", "8"
                sB = "0" & sB
            Case "1", "3", "5", "7", "9"
                sB = "1" & sB
            Case Else
                LongDec2Bin = CVErr(xlErrValue)
            Exit Function
        End Select

        sD = sbDivBy2(sD, True)

        If sD = "0" Then
            Exit Do
        End If
    Loop

    If blNeg And sB <> "1" & String(lBits - 1, "0") Then
        sB = sbBinNeg(sB, lBits)
    End If

    'Test whether string representation is in range and correct
    'If not, the user has to increase lbits

    lLenBinInt = Len(sB)

    If lLenBinInt > lBits Then
        LongDec2Bin = CVErr(x1ErrNum)
        Exit Function
    Else
        If (Len(sB) = lBits) And (Left(sB, 1) <> -blNeg & "") Then
            LongDec2Bin = CVErr(xlErrNum)
            Exit Function
        End If
    End If

    If blZeroize Then sB = Right(String(lBits, "0") & sB, lBits)

    If lPosDec > 0 And lLenBinInt + 1 < lBits Then
        sB = sB & Application.DecimalSeparator
        i = 1

        Do While i + lLenBinInt < lBits
            sFrac = sbDecAdd(sFrac, sFrac) 'Double fractional part

            If Len(sFrac) > lPosDec Then
                sB = sB & "1"
                sFrac = Right(sFrac, lPosDec)

                If sFrac = String(lPosDec, "0") Then
                    Exit Do
                End If
            Else
                sB = sB & "0"
            End If

            i = i + 1
        Loop

        LongDec2Bin = sB
    Else
        LongDec2Bin = sB
    End If
End Function

Function LongBin2Dec(sBinary As String, Optional lBits As Long = 32) As String
    'Transforms binary number into decimal number.
    'Reverse("moc.LiborPlus.www") V0.3 PB 16-Jan-2011

    Dim sBin As String
    Dim sB As String
    Dim sFrac As String
    Dim sD As String
    Dim sR As String
    Dim blNeg As Boolean
    Dim i As Long
    Dim lPosDec As Long

    lPosDec = InStr(sBinary, Application.DecimalSeparator)

    If lPosDec > 0 Then
        If (Left(sBinary, 1) = "1") And Len(sBin) >= lBits Then 'negative fractions later..
            LongBin2Dec = CVErr(xlErrVa1ue)
            Exit Function
        End If

        sBin = Left(sBinary, lPosDec - 1)
        sFrac = Right(sBinary, Len(sBinary) - lPosDec)
        lPosDec = Len(sFrac)
    Else
        sBin = sBinary
        sFrac = ""
    End If

    Select Case Sgn(Len(sBin) - lBits)
        Case 1
            LongBin2Dec = CVErr(x1ErrNum)
            Exit Function
        Case 0
            If Left(sBin, 1) = "1" Then
                sB = sbBinNeg(sBin, lBits)
                blNeg = True
            Else
                sB = sBin
                blNeg = False
            End If
        Case -1
            sB = sBin
            blNeg = False
    End Select

    sD = "1"
    sR = "0"

    For i = Len(sB) To 1 Step -1
        Select Case Mid(sB, i, 1)
            Case "1"
                sR = sbDecAdd(sR, sD)
            Case "0"
                'Do Nothing
            Case Else
                LongBin2Dec = CVErr(xlErrNum)
                Exit Function
        End Select

        sD = sbDecAdd(sD, sD) 'Double sd
    Next i

    If lPosDec > 0 Then 'now the fraction
        sD = "0.5"

        For i = 1 To lPosDec
            If Mid(sFrac, i, 1) = "1" Then
                sR = sbDecAdd(sR, sD)
            End If

            sD = sbDivBy2(sD, False)
        Next i
    End If

    If blNeg Then
        LongBin2Dec = "-" & sR
    Else
        LongBin2Dec = sR
    End If
End Function

Function sbDivBy2(sDecimal As String, blInt As Boolean) As String
    'Divide sDecimal by two, blInt = TRUE returns integer only
    'Reverse("moc.LiborPlus.www") V0.3 PB 16-Jan-2011

    Dim i As Long
    Dim lPosDec As Long
    Dim sDec As String
    Dim sD As String
    Dim lCarry As Long

    If Not blInt Then
        lPosDec = InStr(sDecimal, Application.DecimalSeparator)

        If lPosDec > 0 Then
            'Without decimal point lPosDec already defines location of decimal point
            sDec = Left(sDecimal, lPosDec - 1) & Right(sDecimal, Len(sDecimal) - lPosDec)
        Else
            sDec = sDecimal
            lPosDec = Len(sDec) + 1 'Location of decimal point
        End If

        If ((1 * Right(sDec, 1)) Mod 2) = 1 Then
            sDec = sDec & "0" 'Append zero so that integer algorithm calculates division exactly
        End If
    Else
        sDec = sDecimal
    End If

    lCarry = 0

    For i = 1 To Len(sDec)
        sD = sD & Int((lCarry * 10 + Mid(sDec, i, 1)) / 2)
        lCarry = (lCarry * 10 + Mid(sDec, i, 1)) Mod 2
    Next i

    If Not blInt Then
        If Right(sD, Len(sD) - lPosDec + 1) <> String(Len(sD) - lPosDec + 1, "0") Then
        'frac part Is non - zero
            i = Len(sD)

            Do While Mid(sD, i, 1) = "0"
                i = i - 1 'Skip trailing zeros
            Loop

            'Insert decimal point again
            sD = Left(sD, lPosDec - 1) _
                & Application.DecimalSeparator & Mid(sD, lPosDec, i - lPosDec + 1)
        End If
    End If

    i = 1

    Do While i < Len(sD)
        If Mid(sD, i, 1) = "0" Then
            i = i + 1
        Else
            Exit Do
        End If
    Loop

    If Mid(sD, i, 1) = Application.DecimalSeparator Then
        i = i - 1
    End If

    sbDivBy2 = Right(sD, Len(sD) - i + 1)
End Function

Function sbBinNeg(sBin As String, Optional lBits As Long = 32) As String
    'Negate sBin: take the 2's-complement, then add one
    'Reverse("moc.LiborPlus.www") V0.3 PB 16-Jan-2011

    Dim i As Long
    Dim sB As String

    If Len(sBin) > lBits Or sBin = "1" & String(lBits - 1, "0") Then
        sbBinNeg = CVErr(xlErrValue)
        Exit Function
    End If

    'Calculate 2 's-complement
    For i = Len(sBin) To 1 Step -1
        Select Case Mid(sBin, i, 1)
            Case "1"
                sB = "0" & sB
            Case "0"
                sB = "1" & sB
            Case Else
                sbBinNeg = CVErr(xlErrValue)
            Exit Function
        End Select
    Next i

    sB = String(lBits - Len(sBin), "1") & sB

    'Now add 1
    i = lBits

    Do While i > 0
        If Mid(sB, i, 1) = "1" Then
            Mid(sB, i, 1) = "0"
            i = i - 1
        Else
            Mid(sB, i, 1) = "1"
            i = 0
        End If
    Loop

    'Finally strip leading zeros
    i = InStr(sB, "1")

    If i = 0 Then
        sbBinNeg = "0"
    Else
        sbBinNeg = Right(sB, Len(sB) - i + 1)
    End If
End Function

Function sbDecAdd(sOne As String, sTwo As String) As String
    'Sum up two string decimals.
    'Reverse("moc.LiborPlus.www") V0.3 PB 16-Jan-2011
    Dim lStrLen As Long
    Dim s1 As String
    Dim s2 As String
    Dim sA As String
    Dim sB As String
    Dim sR As String
    Dim d As Long
    Dim lCarry As Long
    Dim lPosDec1 As Long
    Dim lPosDec2 As Long
    Dim sF1 As String
    Dim sF2 As String

    lPosDec1 = InStr(sOne, Application.DecimalSeparator)

    If lPosDec1 > 0 Then
        s1 = Left(sOne, lPosDec1 - 1)
        sF1 = Right(sOne, Len(sOne) - lPosDec1)
        lPosDec1 = Len(sF1)
    Else
        s1 = sOne
        sF1 = ""
    End If

    lPosDec2 = InStr(sTwo, Application.DecimalSeparator)

    If lPosDec2 > 0 Then
        s2 = Left(sTwo, lPosDec2 - 1)
        sF2 = Right(sTwo, Len(sTwo) - lPosDec2)
        lPosDec2 = Len(sF2)
    Else
        s2 = sTwo
        sF2 = ""
    End If

    If lPosDec1 + lPosDec2 > 0 Then
        If lPosDecl > lPosDec2 Then
            sF2 = sF2 & String(lPosDec1 - lPosDec2, "0")
        Else
            sF1 = sFl & String(lPosDec2 - lPosDec1, "0")
            lPosDec1 = lPosDec2
        End If

        sF1 = sbDecAdd(sF1, sF2) 'Add fractions as integer numbers

        If Len(sF1) > lPosDecl Then
            lCarry = 1
            sF1 = Right(sF1, lPosDec1)
        Else
            lCarry = 0
        End If

        Do While lPosDec1 > 0
            If Mid(sF1, lPosDec1, 1) <> "0" Then
                Exit Do
            End If

            lPosDec1 = lPosDec1 - 1
        Loop

        sF1 = Left(sF1, lPosDec1)
    Else
        lCarry = 0
    End If

    lStrLen = Len(sl)

    If lStrLen < Len(s2) Then
        lStrLen = Len(s2)
        sA = String(lStrLen - Len(s1), "0") & s1
        sB = s2
    Else
        sA = s1
        sB = String(lStrLen - Len(s2), "0") & s2
    End If

    Do While lStrLen > 0
        d = 0 + Mid(sA, lStrLen, 1) + Mid(sB, lStrLen, 1) + lCarry

        If d > 9 Then
            sR = (d - 10) & sR
            lCarry = 1
        Else
            sR = d & sR
            lCarry = 0
        End If

        lStrLen = lStrLen - 1
    Loop

    If lCarry > 0 Then
        sR = lCarry & sR
    End If

    If lPosDec1 > 0 Then
        sbDecAdd = sR & Application.DecimalSeparator & sF1
    Else
        sbDecAdd = sR
    End If
End Function

Этот код работает, но иногда (около 1% моих тестовых данных) вы в конечном итоге теряете пару копеек по сравнению с функцией Iris EntDouble из надстройки Excel. Я отнесу это к точности, если только кто-то не сможет это понять.

В конечном счете, заставить это работать в VBA было моим доказательством концепции, чтобы проверить, все ли работает. Предполагаемой платформой для этой функциональности был SQL Server. Если у вас есть БД казначейства, связанная с SQL Server, вы должны иметь возможность запускать эту функцию непосредственно для данных из БД Pervasive. В моем случае мы собираемся выгрузить данные о транзакциях за последние 2,5 года в статическую таблицу на SQL Server, но мы работаем с этими данными только один раз в год, так что это не проблема. Следующие две функции должны помочь вам разобраться. С точки зрения точности они эквивалентны приведенному выше коду VBA, некоторые из них иногда отстают на пару копеек, но кажется, что в 99% случаев это точно то же самое. Мы используем SQL Server 2000, поэтому есть некоторые вещи, которые, вероятно, можно оптимизировать (Varchar(MAX) для одного) для более новых версий, но в конечном итоге, насколько я знаю, это должно работать нормально.

CREATE FUNCTION dbo.FUNCTION_Exchequer_Double
(
    @Val1 AS SmallInt,
    @Val2 AS BigInt
)
RETURNS Decimal(38, 10)
AS
BEGIN
    -- Declare and set decoy variables
    DECLARE @Val1_Decoy AS SmallInt
    DECLARE @Val2_Decoy AS BigInt

    SELECT  @Val1_Decoy = @Val1,
            @Val2_Decoy = @Val2

    -- Declare other variables
    DECLARE @Val1_Binary AS Varchar(16)
    DECLARE @Val2_Binary AS Varchar(32)
    DECLARE @Real48_Binary AS Varchar(48)
    DECLARE @Real48_Decimal AS BigInt
    DECLARE @Exponent AS Int
    DECLARE @Sign AS Bit
    DECLARE @Significand AS Decimal(19, 10)
    DECLARE @BitCounter AS Int
    DECLARE @Two As Decimal(38, 10) -- Saves us casting inline in the code
    DECLARE @Output AS Decimal(38, 10)

    -- Convert values into two binary strings of the correct length (Val1 = 16 bits, Val2 = 32 bits)
    SELECT  @Val1_Binary = Replicate(0, 16 - Len(dbo.FUNCTION_Convert_To_Base(Cast(@Val1_Decoy AS Binary(2)), 2)))
                + dbo.FUNCTION_Convert_To_Base(Cast(@Val1_Decoy AS Binary(2)), 2),
            @Val2_Binary = Replicate(0, 32 - Len(dbo.FUNCTION_Convert_To_Base(Cast(@Val2_Decoy AS Binary(4)), 2)))
                + dbo.FUNCTION_Convert_To_Base(Cast(@Val2_Decoy AS Binary(4)), 2)

    -- Find the decimal value of the new 48 bit number and its binary value
    SELECT  @Real48_Decimal = @Val2_Decoy * Power(2, 16) + @Val1_Decoy
    SELECT  @Real48_Binary = @Val2_Binary + @Val1_Binary

    -- Determine the Exponent (takes the first 8 bits and subtracts 129)
    SELECT  @Exponent = Cast(@Real48_Decimal AS Binary(1)) - 129

    -- Determine the Sign
    SELECT  @Sign = Left(@Real48_Binary, 1)

    -- A bit of setup for determining the Significand
    SELECT  @Significand = 1,
            @Two = 2,
            @BitCounter = 2

    -- Determine the Significand
    WHILE   @BitCounter <= 40
            BEGIN
                IF Substring(@Real48_Binary, @BitCounter, 1) Like '1'
                    BEGIN
                        SELECT @Significand = @Significand + Power(@Two, 1 - @BitCounter)
                    END

                SELECT @BitCounter = @BitCounter + 1
            END

    SELECT  @Output = Power(-1, @Sign) * @Significand * Power(@Two, @Exponent)

    -- Return the output
    RETURN  @Output
END


CREATE FUNCTION dbo.FUNCTION_Convert_To_Base
(
    @value AS BigInt,
    @base AS Int
)
RETURNS Varchar(8000)
AS
BEGIN
    -- Code from http://dpatrickcaldwell.blogspot.co.uk/2009/05/converting-decimal-to-hexadecimal-with.html

    -- some variables
    DECLARE @characters Char(36)
    DECLARE @result Varchar(8000)

    -- the encoding string and the default result
    SELECT  @characters = '0123456789abcdefghijklmnopqrstuvwxyz',
            @result = ''

    -- make sure it's something we can encode.  you can't have
    -- base 1, but if we extended the length of our @character
    -- string, we could have greater than base 36
    IF      @value < 0 Or @base < 2 Or @base > 36
            RETURN Null

    -- until the value is completely converted, get the modulus
    -- of the value and prepend it to the result string.  then
    -- devide the value by the base and truncate the remainder
    WHILE   @value > 0
            SELECT  @result = Substring(@characters, @value % @base + 1, 1) + @result,
                    @value = @value / @base

    -- return our results
    RETURN  @result

END

Не стесняйтесь использовать мой код VBA или SQL. По-настоящему тяжелую работу проделал тот, кто преобразовал его в PHP выше. Если кто-нибудь найдет способ улучшить что-либо, пожалуйста, дайте мне знать, чтобы мы могли сделать этот код как можно более совершенным.

Спасибо!

Команда Delphi Move используется для перемещения блоков памяти из одного места в другое. Это похоже на старый код Delphi — тип Real устарел, заменен на Double (edit Real48 заменяет 6-байтовый Real), а тип Byte, вероятно, лучше использовать, чем Char. Оба являются байтами, но Char больше предназначен для однобайтовых символов (ascii). Что делает этот код:

1) Объявите массив символов Char (здесь можно использовать Byte), длина которого составляет шесть байтов. Также объявите Real (тип edit now Real48) для хранения преобразованного значения.

TheRealArray : Array [1..6] Of Char;
TheReal      : Real;

2) Переместите двухбайтовое значение Int В TheRealArray — начните с index1 и переместите 2 байта данных (т.е. все Int2, SmallInt (16 бит)). Сделайте то же самое с Int4 и начните его с индекса [3], длиной 4 байта.

Move (Int2, TheRealArray[1], 2);
Move (Int4, TheRealArray[3], 4);

если вы начали с (картинка, а не код)

Int2 = [2_byte0][2_byte1]
Int4 = [4_byte0][4_byte1][4_byte2][4_byte3]

вам придется:

TheRealArray = [2_byte0][2_byte1][4_byte0][4_byte1][4_byte2][4_byte3]

Последняя команда перемещения копирует этот массив в ячейку памяти TheReal, которая является вещественным (6-байтным числом с плавающей запятой) типом. Он начинается с index1 массива, копирует его в TheReal и копирует в общей сложности шесть байтов (т.е. все это).

 Move (TheRealArray[1], TheReal, 6);

Предполагая, что данные, хранящиеся в Int2 и Int4, при таком объединении создают правильно отформатированный Real48, тогда вы получите TheReal, содержащий данные в правильном формате.

в PHP строки в основном представляют собой массивы байтов (например, Array[1..6] of Char в Delphi), поэтому вы можете сделать что-то подобное, используя unpack() для преобразования в число с плавающей запятой.

Просто прокручиваю ответ J.... При использовании записи варианта код несколько упрощается:

Function EntConvertInts (Const Int2 : SmallInt;
                         Const Int4 : LongInt) : Double; StdCall;
Type
  TReal48PlaceHolder = record
    case boolean of
    true : (theRealArray : array [1..6] of byte);
    false : (r48 : Real48);
  end;

Var
  R48Rec : TReal48PlaceHolder;
Begin
  Move (Int2, R48Rec.theRealArray[1], 2);
  Move (Int4, R48Rec.theRealArray[3], 4);

  Result := R48Rec.r48;
End;

var
  r : Double;
begin
  r:= EntConvertInts(132,805306368);
  WriteLn(r); // Should be 11
  r:= EntConvertInts(141,1163395072);
  WriteLn(r); // Should be 6315
  ReadLn;

end.

Это не ответ в смысле «кода PHP». Я просто хотел предупредить любого, кто, возможно, найдет этот код по тегу Delphi.

ЭТО БЫЛО НЕ ДЕЛФИ!!!

Это старый код Turbo Pascal. Ладно, может быть, 16-битная Delphi 1, которая действительно была TP на стероидах.

Не пытайтесь использовать этот код в 32-разрядной версии Delphi, по крайней мере, до замены измененных типов Char и Real. Оба этих типа изменены со времен Turbo Pascal, особенно 6-байтовый Real, который никогда не был аппаратно-совместимым с FPU!

Вероятно, FreePascal может содержать ванильный код TurboPascal, если он настроен на правильный режим, но все же лучше использовать режим Delphi и обновленный код.

• http://docwiki.embarcadero.com/Libraries/en/System.Real
• http://docwiki.embarcadero.com/Libraries/en/System.Real48
• http://docwiki.embarcadero.com/RADStudio/en/Real48_compatibility_(Delphi )

Также следует убедиться, что тип SmallInt является 16-битным целым числом (int16), а тип LongInt — 32-битным (int32). Похоже, это верно для 16-битных, 32-битных и 64-битных компиляторов Delphi, но, вероятно, может измениться в других реализациях Pascal.

• http://docwiki.embarcadero.com/Libraries/en/System.Longint
• http://docwiki.embarcadero.com/Libraries/en/System.Smallint

Ниже я пытаюсь изменить код, совместимый с современным Delphi. Я не смог проверить это, хотя.

Надеюсь, это может помочь кому-нибудь когда-нибудь скрыть некоторый аналог старого кода TurboPascal с преобразованием типов в более новые варианты.

Этот код полностью повторяет оригинальный, но более совместимый, лаконичный и быстрый.

{ Reconstitutes a SmallInt and LongInt that form }
{ a Real into a double.                          }
Function EntConvertInts (Const Int2 : SmallInt;
                         Const Int4 : LongInt) : Double; 
(* StdCall; - only needed for non-Pascal DLLs  *)
Var
  TheRealArray : Packed Array [1..6] Of Byte; //AnsiChar  may suffice too

  TheReal      : Real48   absolute TheRealArray;
  TheInt2      : SmallInt absolute TheRealArray[1];
  TheInt4      : LongInt  absolute TheRealArray[3];
Begin
  Assert(SizeOf(TheInt2) = 2);
  Assert(SizeOf(TheInt4) = 2);
  Assert(SizeOf(TheReal) = 6);

  TheInt2 := Int2; (* Move (Int2, TheRealArray[1], 2); *)
  TheInt4 := Int4; (* Move (Int4, TheRealArray[3], 4); *)
                   (* Move (TheRealArray[1], TheReal, 6); *)

  Result := TheReal;
End;

Этот код напрямую использует встроенные функции Turbo Pascal вариантная запись без тегов.

{ Reconstitutes a SmallInt and LongInt that form }
{ a Real into a double.                          }
Function EntConvertInts (Const Int2 : SmallInt;
                         Const Int4 : LongInt) : Double; 
(* StdCall; - only needed for non-Pascal DLLs  *)
Var
  Value : Packed Record
            Case Byte of
              0: (TheReal: Real48);
              1: (Packed Record TheInt2: SmallInt;
                                TheInt4: LongInt; end; );
          end; 
Begin
  Assert(SizeOf(Value.TheInt2) = 2);
  Assert(SizeOf(Value.TheInt4) = 2);
  Assert(SizeOf(Value.TheReal) = 6);

  Value.TheInt2 := Int2; (* Move (Int2, TheRealArray[1], 2); *)
  Value.TheInt4 := Int4; (* Move (Int4, TheRealArray[3], 4); *)
                         (* Move (TheRealArray[1], TheReal, 6); *)

  Result := Value.TheReal;
End;