如何将6byte float转换为double

时间:2012-01-31 16:40:22

标签: php c delphi pervasive pervasive-sql

我正在连接到Pervasive SQL数据库,该数据库在两个字段上分割一些数据。 DOUBLE字段实际上分为fieldName_1和fieldName_2,其中_1是2字节int,_2是4字节int。

我想获取这些值并使用PHP将它们转换为可用值。 我有一些示例代码来进行转换,但它是用Delphi编写的,我不明白:

{ Reconstitutes a SmallInt and LongInt that form }
{ a Real into a double.                          }
Function EntConvertInts (Const Int2 : SmallInt;
                         Const Int4 : LongInt) : Double; StdCall;
Var
  TheRealArray : Array [1..6] Of Char;
  TheReal      : Real;
Begin
  Move (Int2, TheRealArray[1], 2);
  Move (Int4, TheRealArray[3], 4);
  Move (TheRealArray[1], TheReal, 6);

  Result := TheReal;
End;

一些数据[fieldName_1,fieldName_2]

[132,805306368] - >这应该是11

[132,1073741824] - >这应该是12

我不太了解逻辑,无法将其移植到PHP中。非常感激任何的帮助。感谢

EDIT。 这是他们提供的C代码,显示符号/指数:

double real_to_double (real r)
/* takes Pascal real, return C double */
{
    union doublearray da;
    unsigned x;

    x = r[0] & 0x00FF;  /* Real biased exponent in x */
    /* when exponent is 0, value is 0.0 */
    if (x == 0)
        da.d = 0.0;
    else {
        da.a[3] = ((x + 894) << 4) |  /* adjust exponent bias */
                  (r[2] & 0x8000) |  /* sign bit */
                  ((r[2] & 0x7800) >> 11);  /* begin significand */
        da.a[2] = (r[2] << 5) |  /* continue shifting significand */
                  (r[1] >> 11);
        da.a[1] = (r[1] << 5) |
                  (r[0] >> 11);
        da.a[0] = (r[0] & 0xFF00) << 5; /* mask real's exponent */
    }
    return da.d;
}

5 个答案:

答案 0 :(得分:4)

我已经在这个问题上工作了大约一个星期,现在试图为我们的组织整理它。

我们的财务部门使用IRIS Exchequer,我们需要降低成本。使用上面的PHP代码,我设法使用以下代码(包括依赖函数)在Excel VBA中使用它。如果下面没有正确归因,我从www.sulprobil.com获得了所有长期的功能。如果将以下代码块复制并粘贴到模块中,则可以从单元格中引用我的ExchequerDouble函数。

在继续之前,我必须在上面的C / PHP代码中指出一个错误。如果你看一下有效循环:

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%的测试数据)与Excel Addin中的Iris'EntDouble函数相比,最终只有几便士。除非有人能搞清楚,否则我会将其归结为精确度。

最终让这个在VBA工作是我的概念验证,检查一切是否有效。此功能的目标平台是SQL Server。如果您将Exchequer DB链接到SQL Server,则应该能够直接针对Pervasive DB中的数据运行此功能。在我的例子中,我们将把最近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以上。如果有人找到任何改进方法,请告诉我,这样我们就可以使这段代码尽可能完美。

谢谢!

答案 1 :(得分:2)

Delphi的Move命令用于将内存块从一个地方移动到另一个地方。这看起来像旧的Delphi代码 - Real类型已过时,替换为Double编辑 Real48替换6字节Real),以及使用Byte类型可能比使用Char更好。两者都是字节,但Char更适用于单字节字符(ascii)。这段代码的作用是:

1)声明一个Char数组(这里可以使用Byte),长度为6个字节。同时声明Real编辑现在Real48类型)以存储转换后的值。

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

2)将双字节Int值移动到TheRealArray - 从索引1开始并移动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字节浮点)类型。它从数组的索引1开始,将其复制到TheReal,并复制总共六个字节(即:整个事件)。

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

假设存储在Int2和Int4中的数据,当这样连接时,产生一个格式正确的Real48,那么你最终得到的TheReal以正确的格式保存数据。

PHP字符串中的

基本上是字节数组(如Delphi中Char的Array [1..6])所以你可以使用unpack()做类似的事情来转换为float。

答案 2 :(得分:2)

将此添加为另一个答案,因为我终于弄明白了。这是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

答案 3 :(得分:1)

只是转动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.

答案 4 :(得分:0)

这也不是“PHP代码”意义上的答案。我只想警告任何可能通过Delphi标签找到此代码的人。

那不是DELPHI !!!

这是旧的Turbo Pascal代码。好吧,也许是16位Delphi 1,它确实是类固醇的TP。

不要在32位Delphi上尝试此代码,至少在替换更改的Char和Real类型之前不要。这两种类型都是从Turbo Pascal时代改变的,特别是6字节的Real,从来都不是硬件FPU兼容的!

如果设置为正确的模式,可能FreePascal可以承载vanilla TurboPascal代码,但最好还是使用Delphi模式和更新的代码。

还应确保SmallInt类型为16位整数(int16),LongInt为32位(int32)。这似乎适用于16位,32位和64位Delphi编译器,但在其他Pascal实现中可能会有所改变。

下面我尝试修改与现代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功能tagless variant record

{ 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;