Are there any ways so I can generate random numbers from 0 to &HFFFFFFFF in Visual Basic 6.0?
I am using the following function
Function RandomNumberLong(Lowerbound As Long, Upperbound As Long) As Long
RandomNumberLong = Clng((Upperbound - Lowerbound + 1) * Rnd + Lowerbound)
End Function
If I use
x = RandomNumberLong(0,&HFFFFFFFF)
It always returns 0
The problem here is the max value of long can hold is 7FFFFFFF or 2147483647 in decimal
So how I am supposed to fix this? Even if I use a single data type it always return negative without unsigned numbers.
According to MSDN Long type
Long (long integer) variables are stored as signed 32-bit (4-byte)
numbers ranging in value from -2,147,483,648 to 2,147,483,647.
Thetype-declaration character for Long is the ampersand (&).
But the value of FFFFFFFF is equal to -1 or 4294967294 which overflow.
I think I am confused on this.
Edited:
Since this seems to be a little bit complicated, i have coded a small Shell code to use the RDTSC instruction instead to generate a random long number including singed and unsigned.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Option Explicit
Private Sub Form_Load()
Dim x(1 To 10) As Byte, VAL As Long
CopyMemory x(1), &H60, 1 'PUSHAD
CopyMemory x(2), &H310F, 2 'RDTSC EAX holds a random value
CopyMemory x(4), &HA3, 1 'MOV EAX
CopyMemory x(5), VarPtr(VAL), 4 'Pointer of variable // MOV DWORD [VAL],EAX
CopyMemory x(9), &H61, 1 'POPAD
CopyMemory x(10), &HC3, 1 'RET
CallWindowProc VarPtr(x(1)), 0, 0, 0, 0 'Call the shellcode
MsgBox VAL
End Sub
&HFFFFFFFF - represents a 32-bit signed integer, and the value of &HFFFFFFFF overflows the integer and becomes -1
Hence, when you call RandomNumberLong function, you are passing 0 to Lowerbound and -1 to Upperbound
In order to fix this in Vb.NET, use &HFFFFFFFFL or &HFFFFFFFF& to indicate Long type literal. I am not sure how to fix this as quickly in VB6 as in VB.NET from the example above. I guess you will need to write your own function to convert large HEX numbers to double and pass the number instead of the HEX.
EDIT:
I don't think VB6 allows you to convert &HFFFFFFFF to anything but base 16, which overflows and results in -1:
EDIT 2:
You can convert some Hex numbers into other datatype by adding & to the end:
&HFFFF = -1
&HFFFF& = 65535
Still, there seems to be a limit to the Hex number in VB6 (base 16 only?) because:
VB.NET:
&HFFFFFFFF&=4294967295
VB6:
&HFFFFFFFF&=-1
MSDN: Type Characters (Visual Basic)
The compiler normally construes an integer literal to be in the decimal (base 10) number system. You can force an integer literal to be hexadecimal (base 16) with the &H prefix, and you can force it to be octal (base 8) with the &O prefix. The digits that follow the prefix must be appropriate for the number system.
Truth is that VB6 Long is 32-bit signed integer data type. As such it simply cannot store &HFFFFFFFF (MSDN). But (1) you seem to be OK with using Long anyway, and (2) you do not explain what is your use case, and if it is really that crucial to work in a positive range only.
One can use the following function to generate random Long values from the whole range of Long data type (i.e. from -&H80000000 to &H7FFFFFFF):
Function RandomNumberLong() As Long
RandomNumberLong = &H7FFFFFFF * Rnd() + (-1 - &H7FFFFFFF) * Rnd()
End Function
The problem is that VB6 converts any hex number which exits out of only "F" to -1
This will make your function to use -1 as its upperbound, and causes it to return 0
By separating the 8 digits into 2 variables with 4 digits, you still have the same problem as VB6 will still convert &HFFFF to -1 which will make your function to return 0 again.
A solution is to add &H10000 to the 4 digit variables before converting, and substracting Val("&H10000") after the conversion has been done.
After that you can use these 2 values to obtain 2 random numbers, and combine them into 1 random 8 digit hex number.
Below is a test project which shows what i mean:
'1 form with:
' 1 command button: name=Command1
Option Explicit
Private Sub Command1_Click()
Dim strX As String
Dim lngX As Long
strX = RndHex("FFFFFFFF")
lngX = Val("&H" & strX)
Caption = strX & " = " & CStr(Hex$(lngX)) & " = " & CStr(lngX)
End Sub
Function RndHex(strMax As String) As String
Dim strMax1 As String, strMax2 As String
Dim lngMax1 As Long, lngMax2 As Long
Dim lngVal1 As Long, lngVal2 As Long
Dim strVal1 As String, strVal2 As String
'make sure max is 8 digits
strMax1 = Right$("00000000" & strMax, 8)
'split max in 2 parts
strMax2 = Right$(strMax1, 4)
strMax1 = Left$(strMax1, 4)
'convert max values from string to values
lngMax1 = Val("&H1" & strMax1) - Val("&H10000")
lngMax2 = Val("&H1" & strMax2) - Val("&H10000")
'calculate separate random values
lngVal1 = CLng(lngMax1 + 1) * Rnd
lngVal2 = CLng(lngMax2 + 1) * Rnd
'convert values to 4 digit hex strings
strVal1 = Right$("0000" & Hex$(lngVal1), 4)
strVal2 = Right$("0000" & Hex$(lngVal2), 4)
'combine 2 random values and return the result as an 8 digit hex string
RndHex = strVal1 & strVal2
End Function
Private Sub Form_Load()
'seed random generator with system timer
Randomize
End Sub
Run the project above and click the command button and view the values in the caption of the form.
Rnd will only give you 24 bits of randomness since it returns a Single.
RandomNumberLong = Clng(&HFFFF * Rnd()) + (Clng(&HFFFF * Rnd()) * &H10000)
will construct a 32-bit value from two 16-bit random integers.
UPDATE - well, it won't, because as Hrqls points out, &HFFFF is -1 in VB. Instead:
RandomNumberLong = Clng(65535 * Rnd()) + (Clng(65535 * Rnd()) * 65536)
Related
Hello i am trying to make a code that removes the last digit from an integer example
int num = 1234
to be
int num 123
I did the same code in C# but i am failing to do it on vb6 this is the c# code.
num = num.Remove(num.length -1)
on vb6 i tried something like this
num = Len(num) -1
but all it does is from
num = 1234
it makes it
num = 1233
or just shows
num = 3
since removed the 4th digit
You are on the right path. The key missing step is to convert the number to a string before manipulating it.
Option Explicit
Private Sub Command1_Click()
Dim num As Integer
Dim s As String
num = 1234
s = CStr(num) 'convert number to a string
s = Left(s, Len(s) - 1) 'remove last digit
num = CInt(s) 'convert string back to a number
Debug.Print num
End Sub
The error in your code is using Len on an Integer. From the documentation:
Returns a Long containing the number of characters in a string or the
number of bytes required to store a variable.
You can simply divide your number by 10:
Function TrimInteger(number As Integer) As Integer
TrimInteger = Int(number / 10)
End Function
Int is used to remove the fractional part of the division result and return the resulting integer value.
You can also declare number and the Function's return type as a Long instead of an Integer to support larger numbers:
Function TrimNumber(number As Long) As Long
TrimNumber = Int(number / 10)
End Function
Using SNMP version 3, I am creating a user.
Right now, I have it set up where I clone a user and that works just fine. However, I need to change the new user's authKey. How can I do this? I know the oid for authKeyChange, however, I don't know how to generate the new key. How do I generate that key? Can it be done using SNMPSharpNet?
If there is an easier way to do this while I'm creating the user, I can do that as well. ANY way to change the authKey (and privKey, but one step at a time) is much appreciated. I'm using VB.net if it means anything.
So I've figured out how to do this. It's a bit of a complex process. I followed this document, which is rfc2574. Do a ctrl+F for "keyChange ::=" and you'll find the paragraph walking you through the algorithm to generate the keyChange value. The following code has worked reliably to generate the keyChange value. All you have to do from this point is push the keyChange value to the usmAuthKeyChange OID. If you are changing the privacy password, you push the keyChange value to the usmPrivKeyChange OID. I'm ashamed to say that due to the time crunch, I did not have time to make this work completely, so when using SHA, I had to code an entirely new method that did almost the exact same thing. Again, I'm ashamed to post it, but I know how much I was banging my head against a wall, and if someone comes here later and sees this, I would like them to know what to do without going through the struggle.
Here is all of the code you need using VB.Net and the SNMPSharpNet library:
Private Function GenerateKeyChange(ByVal newPass As String, ByVal oldPass As String, ByRef target As UdpTarget, ByRef param As SecureAgentParameters) As Byte()
Dim authProto As AuthenticationDigests = param.Authentication
Dim hash As IAuthenticationDigest = Authentication.GetInstance(authProto)
Dim L As Integer = hash.DigestLength
Dim oldKey() As Byte = hash.PasswordToKey(Encoding.UTF8.GetBytes(oldPass), param.EngineId)
Dim newKey() As Byte = hash.PasswordToKey(Encoding.UTF8.GetBytes(newPass), param.EngineId)
Dim random() As Byte = Encoding.UTF8.GetBytes(GenerateRandomString(L))
Dim temp() As Byte = oldKey
Dim delta(L - 1) As Byte
Dim iterations As Integer = ((newKey.Length - 1) / L) - 1
Dim k As Integer = 0
If newKey.Length > L Then
For k = 0 To iterations
'Append random to temp
Dim merged1(temp.Length + random.Length - 1) As Byte
temp.CopyTo(merged1, 0)
random.CopyTo(merged1, random.Length)
'Store hash of temp in itself
temp = hash.ComputeHash(merged1, 0, merged1.Length)
'Generate the first 16 values of delta
For i = 0 To L - 1
delta(k * L + i) = temp(i) Xor newKey(k * L + i)
Next
Next
End If
'Append random to temp
Dim merged(temp.Length + random.Length - 1) As Byte
temp.CopyTo(merged, 0)
random.CopyTo(merged, temp.Length)
'Store hash of temp in itself
temp = hash.ComputeHash(merged, 0, merged.Length)
'Generate the first 16 values of delta
For i = 0 To (newKey.Length - iterations * L) - 1
delta(iterations * L + i) = temp(i) Xor newKey(iterations * L + i)
Next
Dim keyChange(delta.Length + random.Length - 1) As Byte
random.CopyTo(keyChange, 0)
delta.CopyTo(keyChange, random.Length)
Return keyChange
End Function
Private Function GenerateKeyChangeShaSpecial(ByVal newPass As String, ByVal oldPass As String, ByRef target As UdpTarget, ByRef param As SecureAgentParameters) As Byte()
Dim authProto As AuthenticationDigests = param.Authentication
Dim hash As IAuthenticationDigest = Authentication.GetInstance(authProto)
Dim L As Integer = 16
Dim oldKey() As Byte = hash.PasswordToKey(Encoding.UTF8.GetBytes(oldPass), param.EngineId)
Dim newKey() As Byte = hash.PasswordToKey(Encoding.UTF8.GetBytes(newPass), param.EngineId)
Array.Resize(oldKey, L)
Array.Resize(newKey, L)
Dim random() As Byte = Encoding.UTF8.GetBytes(GenerateRandomString(L))
Dim temp() As Byte = oldKey
Dim delta(L - 1) As Byte
Dim iterations As Integer = ((newKey.Length - 1) / L) - 1
Dim k As Integer = 0
If newKey.Length > L Then
For k = 0 To iterations
'Append random to temp
Dim merged1(temp.Length + random.Length - 1) As Byte
temp.CopyTo(merged1, 0)
random.CopyTo(merged1, random.Length)
'Store hash of temp in itself
temp = hash.ComputeHash(merged1, 0, merged1.Length)
Array.Resize(temp, L)
'Generate the first 16 values of delta
For i = 0 To L - 1
delta(k * L + i) = temp(i) Xor newKey(k * L + i)
Next
Next
End If
'Append random to temp
Dim merged(temp.Length + random.Length - 1) As Byte
temp.CopyTo(merged, 0)
random.CopyTo(merged, temp.Length)
'Store hash of temp in itself
temp = hash.ComputeHash(merged, 0, merged.Length)
Array.Resize(temp, L)
'Generate the first 16 values of delta
For i = 0 To (newKey.Length - iterations * L) - 1
delta(iterations * L + i) = temp(i) Xor newKey(iterations * L + i)
Next
Dim keyChange(delta.Length + random.Length - 1) As Byte
random.CopyTo(keyChange, 0)
delta.CopyTo(keyChange, random.Length)
Return keyChange
End Function
Private Function GenerateRandomString(ByVal length As Integer) As String
Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
Dim r As New Random
Dim sb As New StringBuilder
For i As Integer = 1 To length
Dim idx As Integer = r.Next(0, 51)
sb.Append(s.Substring(idx, 1))
Next
Return sb.ToString()
End Function
Again, I am oh so well aware this code is hideous, but it works, and that is all I needed in the meantime. I understand this is technical debt and not the way I should code, but it's here and I hope you can get some use out of it.
If this doesn't work, don't forget to go to frc2574 and look at the algorithm.
First time I am developing the vb 6.0 application
I am trying to convert huge Byte Array of size(164999) into Long/Integer Array in VB 6.0 but it gives me an Overflow Error.
my code
Dim tempByteData() As Byte // of size (164999)
Dim lCount As Long
Private Sub Open()
lCount = 164999 **//here I get the count i.e. 164999**
ReDim tempByteData(lCount - 1)
For x = 0 To obj.BinaryValueCount - 1
tempwaveformData(x) = CByte(obj.BinaryValues(x))
Next
tempByteData(lCount - 1) = BArrayToInt(tempByteData)
End Sub
Private Function BArrayToInt(ByRef bArray() As Byte) As Long
Dim iReturn() As Long
Dim i As Long
ReDim iReturn(UBound(bArray) - 1)
For i = 0 To UBound(bArray) - LBound(bArray)
iReturn(i) = iReturn(i) + bArray(i) * 2 ^ i
Next i
BArrayToInt = iReturn(i)
End Function
what needs to be done so that all Byte Array data is converted into Long/Integer Array or any alternate way than this to stored these byte array so that overflow exception not occurred
Depending on the layout of the 32-bit data in the byte array, you can do a straight memory copy from one array to the other.
This will only work if the data is little endian (normal for Win32 applications/data, but not always guaranteed)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Function ByteArrayToLongArray(ByRef ByteArray() As Byte) As Long()
Dim LongArray() As Long
Dim Index As Long
'Create a Long array big enough to hold the data in the byte array
'This assumes its length is a multiple of 4.
ReDim LongArray(((UBound(ByteArray) - LBound(ByteArray) + 1) / 4) - 1)
'Copy the data wholesale from one array to another
CopyMemory LongArray(LBound(LongArray)), ByteArray(LBound(ByteArray)), UBound(ByteArray) + 1
'Return the resulting array
ByteArrayToLongArray = LongArray
End Function
If however the data is big endian, then you will need to convert each byte at a time:
Private Function ByteArrayToLongArray(ByRef ByteArray() As Byte) As Long()
Dim LongArray() As Long
Dim Index As Long
'Create a Long array big enough to hold the data in the byte array
'This assumes its length is a multiple of 4.
ReDim LongArray(((UBound(ByteArray) - LBound(ByteArray) + 1) / 4) - 1)
'Copy each 4 bytes into the Long array
For Index = LBound(ByteArray) To UBound(ByteArray) Step 4
'Little endian conversion
'LongArray(Index / 4) = (ByteArray(Index + 3) * &H1000000&) Or (ByteArray(Index + 2) * &H10000&) Or (ByteArray(Index + 1) * &H100&) Or (ByteArray(Index))
'Big endian conversion
LongArray(Index / 4) = (ByteArray(Index) * &H1000000&) Or (ByteArray(Index + 1) * &H10000&) Or (ByteArray(Index + 2) * &H100&) Or (ByteArray(Index + 3))
Next
'Return the resulting array
ByteArrayToLongArray = LongArray
End Function
(This example currently breaks if the first byte of each quad is greater than 127 which signifies a negative number.)
I'm implementing a variation of the SuperFastHash in VBA for use in Excel (32-bit version, so no LongLong available) to hash strings.
To get around the limitations of signed 32-bit Long values, I'm doing the addition and bit-shifting using Double types, and then converting from Double to Long in a way that truncates it at 31 bits (the maximum positive value -- don't want to deal with two's complement and signs).
I'm getting answers and avoiding overflows so far, but I have a suspicion I'm making some mistakes in translation, since most implementations use all 32 bits of a uint and also deal with individual bytes from an array rather than 16-bit values coming from AscW().
Specific portions of the implementation I'm hoping someone can gut-check:
How I'm testing 16-bit character words rather than 4-byte chunks.
Whether my bit-shifting operations are technically correct, given the caveat that I need to truncate Long values at 31 bits.
Whether the final avalanche piece is still appropriate given the hash only uses 31 bits.
Here's the current code:
Public Function shr(ByVal Value As Long, ByVal Shift As Byte) As Long
shr = Value
If Shift > 0 Then shr = shr \ (2 ^ Shift)
End Function
Public Function shl(ByVal Value As Long, ByVal Shift As Byte) As Long
If Shift > 0 Then
shl = LimitDouble(CDbl(Value) * (2& ^ Shift))
Else
shl = Value
End If
End Function
Public Function LimitDouble(ByVal d As Double) As Long
'' Prevent overflow by lopping off anything beyond 31 bits
Const MaxNumber As Double = 2 ^ 31
LimitDouble = CLng(d - (Fix(d / MaxNumber) * MaxNumber))
End Function
Public Function SuperFastHash(ByVal dataToHash As String) As Long
Dim dataLength As Long
dataLength = Len(dataToHash)
If (dataLength = 0) Then
SuperFastHash = 0
Exit Function
End If
Dim hash As Long
hash = dataLength
Dim remainingBytes As Integer
remainingBytes = dataLength Mod 2
Dim numberOfLoops As Integer
numberOfLoops = dataLength \ 2
Dim currentIndex As Integer
currentIndex = 0
Dim tmp As Double
Do While (numberOfLoops > 0)
hash = LimitDouble(CDbl(hash) + AscW(Mid$(dataToHash, currentIndex + 1, 1)))
tmp = shl(AscW(Mid$(dataToHash, currentIndex + 2, 1)), 11) Xor hash
hash = shl(hash, 16) Xor tmp
hash = LimitDouble(CDbl(hash) + shr(hash, 11))
currentIndex = currentIndex + 2
numberOfLoops = numberOfLoops - 1
Loop
If remainingBytes = 1 Then
hash = LimitDouble(CDbl(hash) + AscW(Mid$(dataToHash, currentIndex + 1, 1)))
hash = hash Xor shl(hash, 10)
hash = LimitDouble(CDbl(hash) + shr(hash, 1))
End If
'' Final avalanche
hash = hash Xor shl(hash, 3)
hash = LimitDouble(CDbl(hash) + shr(hash, 5))
hash = hash Xor shl(hash, 4)
hash = LimitDouble(CDbl(hash) + shr(hash, 17))
hash = hash Xor shl(hash, 25)
hash = LimitDouble(CDbl(hash) + shr(hash, 6))
SuperFastHash = hash
End Function
I would suggest that rather than messing around with doubles, you would probably be better off splitting the 32-bit word into two "16-bit" parts, each of which is held in a signed 32-bit variable (use the lower 16 bits of each variable, and then "normalize" the value between steps:
highPart = (highPart + (lowPart \ 65536)) and 65535
lowPart = lowPart and 65535
Shifting left 16 places simply means copying the low part to the high part and zeroing the low part. Shifting right 16 places simply means copying the high part to the low part and zeroing the high part. Shifting left a smaller number of places simply means shifting both parts separately and then normalizing. Shifting a normalized number right a smaller number of places means shifting both parts left (16-N) bits, normalizing, and shifting right 16 bits.
VB6 doesn't appear to make it that easy to store +infinity, -infinity and NaN into double vars. It would help if it could so that I could do comparisons with those values in the context of complex numbers. How?
Actually, there is a MUCH simpler way to get Infinity, -Infinity and 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
A few different things. As you can see from Pax's example, you really just need to look up the IEEE 754 standard and then plug your bytes into the right places. The only caution I would give you is that MicroSoft has deprecated RtlMoveMemory due to it's potential for creating security issues of the overflow type. As an alternative you can accomplish this in "pure" VB with a little careful coercion using User Defined Types and LSet. (Also note that there are two types of 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
One last side note, you can also get NaN this way:
Public Function GetNaN() As Double
On Error Resume Next
GetNaN = 0 / 0
End Function
This page shows a slightly torturous way to do it. I've trimmed it down to match what your question asked for but haven't tested thoroughly. Let me know if there's any problems. One thing I noticed on that site is that the code they had for a quiet NaN was wrong, it should start the mantissa with a 1-bit - they seemed to have got that confused with a signalling 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
It basically uses kernel-level memory copies to transfer the bit patterns from a byte array to the double.
You should keep in mind however that there are multiple bit-values that can represent QNaN, specifically the sign bit can be 0 or 1 and all bits of the mantissa other than the first can also be zero or 1. This may complicate your strategy for comparisons unless you can discover if VB6 only uses one of the bit patterns - it won't affect the initialization of those values however, assuming VB6 properly implements IEE754 doubles.