VB6如何用+ infinity，-infinity和NaN初始化双精度？

Question

VB6似乎并没有让它很容易将+ infinity，-infinity和NaN存储到双重变量中。如果可以的话，这将有助于我在复杂数字的背景下与这些值进行比较。怎么样？

Answer 1

一些不同的东西。正如你从Pax的例子中可以看到的，你只需要查看IEEE 754标准，然后将你的字节插入正确的位置。我会给你的唯一警告是MicroSoft has deprecated RtlMoveMemory，因为它可能会产生溢出类型的安全问题。作为替代方案，您可以使用“用户定义类型”和“LSet”在“纯”VB中稍微小心地强制执行此操作。 （另请注意，有两种不同的NaN。）

Option Explicit 

Public Enum abIEEE754SpecialValues 
    abInfinityPos 
    abInfinityNeg 
    abNaNQuiet 
    abNaNSignalling 
    abDoubleMax 
    abDoubleMin 
End Enum 

Private Type TypedDouble 
    value As Double 
End Type 

Private Type ByteDouble 
    value(7) As Byte 
End Type 

Public Sub Example() 
    MsgBox GetIEEE754SpecialValue(abDoubleMax) 
End Sub 

Public Function GetIEEE754SpecialValue(ByVal value As abIEEE754SpecialValues) As Double 
    Dim dblRtnVal As Double 
    Select Case value 
    Case abIEEE754SpecialValues.abInfinityPos 
     dblRtnVal = BuildDouble(byt6:=240, byt7:=127) 
    Case abIEEE754SpecialValues.abInfinityNeg 
     dblRtnVal = BuildDouble(byt6:=240, byt7:=255) 
    Case abIEEE754SpecialValues.abNaNQuiet 
     dblRtnVal = BuildDouble(byt6:=255, byt7:=255) 
    Case abIEEE754SpecialValues.abNaNSignalling 
     dblRtnVal = BuildDouble(byt6:=248, byt7:=255) 
    Case abIEEE754SpecialValues.abDoubleMax 
     dblRtnVal = BuildDouble(255, 255, 255, 255, 255, 255, 239, 127) 
    Case abIEEE754SpecialValues.abDoubleMin 
     dblRtnVal = BuildDouble(255, 255, 255, 255, 255, 255, 239, 255) 
    End Select 
    GetIEEE754SpecialValue = dblRtnVal 
End Function 

Public Function BuildDouble(_ 
    Optional byt0 As Byte = 0, _ 
    Optional byt1 As Byte = 0, _ 
    Optional byt2 As Byte = 0, _ 
    Optional byt3 As Byte = 0, _ 
    Optional byt4 As Byte = 0, _ 
    Optional byt5 As Byte = 0, _ 
    Optional byt6 As Byte = 0, _ 
    Optional byt7 As Byte = 0 _ 
    ) As Double 
    Dim bdTmp As ByteDouble, tdRtnVal As TypedDouble 
    bdTmp.value(0) = byt0 
    bdTmp.value(1) = byt1 
    bdTmp.value(2) = byt2 
    bdTmp.value(3) = byt3 
    bdTmp.value(4) = byt4 
    bdTmp.value(5) = byt5 
    bdTmp.value(6) = byt6 
    bdTmp.value(7) = byt7 
    LSet tdRtnVal = bdTmp 
    BuildDouble = tdRtnVal.value 
End Function 

最后一个侧面说明，你还可以得到NaN的这样：

Public Function GetNaN() As Double 
    On Error Resume Next 
    GetNaN = 0/0 
End Function 

Answer 2

This page显示了一个稍微折磨的方式来做到这一点。我已经将它缩小以符合你所要求的问题，但没有完全测试。让我知道是否有任何问题。我在该网站上注意到的一件事是，他们为安静的NaN编写的代码是错误的，它应该以1位开始尾数 - 他们似乎已经与信号NaN混淆了。

Public NegInfinity As Double 
Public PosInfinity As Double 
Public QuietNAN As Double 

Private Declare Sub CopyMemoryWrite Lib "kernel32" Alias "RtlMoveMemory" (_ 
    ByVal Destination As Long, source As Any, ByVal Length As Long) 

' IEEE754 doubles:               ' 
' seeeeeee eeeemmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm ' 
' s = sign                ' 
' e = exponent               ' 
' m = mantissa               ' 
' Quiet NaN: s = x, e = all 1s, m = 1xxx...        ' 
' +Inf  : s = 0, e = all 1s, m = all 0s.        ' 
' -Inf  : s = 1, e = all 1s, m = all 0s.        ' 

 

Public Sub Init() 
    Dim ptrToDouble As Long 
    Dim byteArray(7) As Byte 
    Dim i As Integer 

    byteArray(7) = &H7F 
    For i = 0 To 6 
     byteArray(i) = &HFF 
    Next 
    ptrToDouble = VarPtr(QuietNAN) 
    CopyMemoryWrite ptrToDouble, byteArray(0), 8 

    byteArray(7) = &H7F 
    byteArray(6) = &HF0 
    For i = 0 To 5 
     byteArray(i) = 0 
    Next 
    ptrToDouble = VarPtr(PosInfinity) 
    CopyMemoryWrite ptrToDouble, byteArray(0), 8 

    byteArray(7) = &HFF 
    byteArray(6) = &HF0 
    For i = 0 To 5 
     byteArray(i) = 0 
    Next 
    ptrToDouble = VarPtr(NegInfinity) 
    CopyMemoryWrite ptrToDouble, byteArray(0), 8 
End Sub 

它基本上使用内核级存储器拷贝到所述位模式从字节数组的双重传输。

你应该记住然而，有能够代表QNAN多位值，特别是符号位可以是0或1，除了第尾数的所有位也可以是0或1。这可能会使您的比较策略复杂化，除非您可以发现VB6是否只使用一种位模式 - 但它不会影响这些值的初始化，但假设VB6正确实现了IEE754双工。

Answer 3

其实，还有一个更简单的方式来获得无穷，负无穷，而不是一个号码：

public lfNaN as Double ' or As Single 
public lfPosInf as Double 
public lfNegInf as Double 

on error resume next ' to ignore Run-time error '6': Overflow and '11': Division by zero 
lfNaN = 0/0  ' -1.#IND 
lfPosInf = 1/0  ' 1.#INF 
lfNegInf = -1/0  ' -1.#INF 

on error goto 0   ' optional to reset the error handler