How to convert REAL48 float into a double

2019-07-03 23:38发布

I am connecting to a Pervasive SQL database which splits some data over two fields. DOUBLE fields are actually split into fieldName_1 and fieldName_2 where _1 is a 2 byte int and _2 is a 4 byte int.

I want to take these values and convert them using PHP into a usable value. I have some example code to do the conversion, but it is written in Delphi which I do not understand:

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

Some data [fieldName_1,fieldName_2]

[132, 805306368] -> this should be 11

[132, 1073741824] -> this should be 12

I don't understand the logic enough to be able to port this into PHP. Any help would be most appreciated. Thanks

EDIT. This is the C code that they provided, showing sign/exponent:

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条回答
Melony?
2楼-- · 2019-07-04 00:16

Adding this as another answer because I've finally figured this out. Here is PHP code which will convert the values. It has to be manually calculated because PHP does not know how to unpack a Real48 (non standard). Explanation in comments below.

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
查看更多
Viruses.
3楼-- · 2019-07-04 00:18

That is nor answer in "PHP code" sense. I just wanted to warn any person who maybe would find this code by Delphi tag.

THAT WAS NOT DELPHI !!!

It is old Turbo Pascal code. Okay, maybe 16-bit Delphi 1, which really was TP on steroids.

Don't try this code on 32-bit Delphi, at least not before replacing Char and Real types that changed. Both those types are changed from Turbo Pascal times, especially 6-byte Real which never was hardware FPU-compatible!

Probably FreePascal can bear vanilla TurboPascal code if settled to proper mode, but better still use Delphi mode and updated code.

One should also ensure that SmallInt type is 16-bit integer (int16) and LongInt is 32-bit(int32). This seemes to hold for 16-bit, 32-bit and 64-bit Delphi compilers, yet probably may change in other Pascal implementations.

Below i try to modify code compatible with modern Delphi. I was not able to test it though.

Hopefully that might help someone someday covert some similat old type-casting TurboPascal code to newer flavours.

This code is directly following original one, yet more compatible, concise and fast.

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

This code is directly using native Turbo Pascal features 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;
查看更多
来,给爷笑一个
4楼-- · 2019-07-04 00:27

Just spinning on J...'s answer. Utilizing a variant record the code is somewhat simplified :

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.
查看更多
萌系小妹纸
5楼-- · 2019-07-04 00:33

Delphi's Move command is used for moving blocks of memory from one place to another. This looks like old Delphi code - the Real type is obsolete, replaced with Double (edit Real48 replaces 6-byte Real), and the Byte type is probably a better one to use than Char. Both are bytes, but Char is more meant for single byte characters (ascii). What this code is doing is:

1) Declare an array of Char(could use Byte here) which is six bytes in length. Also declare a Real (edit now Real48 type) to store the converted value.

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

2) Move the two-byte Int value TO TheRealArray - start at index1 and move 2 bytes of data (ie: all of Int2, a SmallInt (16-bits)). Do the same with Int4 and start it at index [3], 4 bytes long.

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

if you started with (picture, not code)

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

you would have:

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

The final move command copies this array to the memory location of TheReal, which is a real (6-byte float) type. It starts at index1 of the array, copies it to TheReal, and copies a total of six bytes (ie:the whole thing).

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

Assuming that the data stored in Int2 and Int4, when concatenated like this, produce a properly formatted Real48 then you end up with TheReal holding the data in the proper format.

in PHP strings are fundamentally byte arrays (like Array[1..6] of Char in Delphi) so you could do the something similar using unpack() to convert to float.

查看更多
爷的心禁止访问
6楼-- · 2019-07-04 00:39

I've been working on this issue for about a week now trying to get it sorted out for our organisation.

Our Finance dept use IRIS Exchequer and we need to get costs out. Using the above PHP code, I managed to get it working in Excel VBA with the following code (includes dependent functions). If not properly attributed below, I got all the long dec to bin functions from www.sulprobil.com. If you copy and paste the following code block into a Module you can reference my ExchequerDouble function from a cell.

Before I continue, I have to point out one error in the C/PHP code above. If you look at the Significand loops:

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

I noticed during testing that the answers were very close but often incorrect. Drilling further down I narrowed it down to the Significand. It might be a problem with translating the code from one language/methodology to another, or may have simply been a typo, but adding that (1 - i) made all the difference.

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

This code works, but sometimes (around 1% of my test data) you end up a couple pennies out compared to Iris' EntDouble function from the Excel Addin. I'll attribute this to precision, unless someone can figure it out.

Ultimately getting this working in VBA was my proof of concept to check everything worked. The intended platform for this functionality was SQL Server. If you have your Exchequer DB linked to a SQL Server you should be able to run this function directly against the data from the Pervasive DB. In my case, we are going to dump out the last 2.5 years worth of transaction data into a static table on SQL Server, but we're only working with this data once a year so it's not an issue. The following two functions should sort you out. In terms of precision, they are equivalent to the VBA code above with some being out by a couple pennies sometimes, but it seems 99% of the time it's exactly the same. We use SQL Server 2000 so there are some things that can probably be optimised (Varchar(MAX) for one) for newer versions but ultimately this should work fine as far as I know.

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

Feel free to use either my VBA or SQL code. The truly hard work was done by whoever converted it to PHP above. If anyone finds any way of improving anything please do let me know so we can make this code as perfect as possible.

Thanks!

查看更多
登录 后发表回答