你如何让 VB6 用 +infinity、-infinity 和 NaN 初始化双精度数？

Posted 2023-03-11

【中文标题】你如何让 VB6 用 +infinity、-infinity 和 NaN 初始化双精度数？

【英文标题】：How do you get VB6 to initialize doubles with +infinity, -infinity and NaN?

【发布时间】：2010-10-27 12:36:17

【问题描述】：

VB6 似乎并不容易将 +infinity、-infinity 和 NaN 存储到双变量中。如果可以的话，这将有所帮助，这样我就可以在复数的上下文中与这些值进行比较。怎么样？

【参考方案1】：

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，除第一个以外的尾数的所有位也可以是零或 1。这可能会使您的比较策略复杂化，除非您能发现 VB6 是否仅使用其中一种位模式 - 但是，假设 VB6 正确实现 IEE754 双精度，它不会影响这些值的初始化。

【讨论】：

所以你链接到原始提问者的博客，他在提问前一天发布了一个他最好的文章？很公平，只是有点有趣！

这不仅有趣，而且很搞笑。当时我实际上并不知道提问者是该博客的所有者，但是博客上有他的 *** 绰号 :-) 对于是否删除此答案，我有两种想法。如果不出意外，它可能会为其他人提供一些乐趣。

不知道该笑还是该尴尬。

【参考方案2】：

实际上，有一种更简单的方法来获得 Infinity、-Infinity 和 Not a Number：

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

【讨论】：

+1 我以前从来不知道！看起来你也可以通过评估 0/0 来获得 NAN？无论如何，Debug.Print 说那是 -1.#IND 与我从 1/0 得到的 1.#INF 不同。我假设它是 NAN。

Debug.Print -lfNaN 给出1.#QNAN，我认为这是“安静”的 NaN (?)。

【参考方案3】：

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

【讨论】：

这是非常棒的东西。非常感谢分享。