[VB6] MAXDOUBLE, MINDOUBLE, +INFINITY, -INFINITY and NaN

VB6 doesn't seem to be able to specify that a Double contains MAXDOUBLE, MINDOUBLE, +INFINITY, -INFINITY or NaN. (I could be wrong on that as there may be some undocumented feature hiding in there somewhere.)

Anyway, I came up with a way of storing these values into Doubles so that they could be used in a Complex Numbers library I've been writing.

Essentially, I create an 8 byte array, load it up with the relevant values, and then, using API calls and the VarPtr function, store the contents of the array into the storage used by the Double.

Here's the code. First the declarations.

Public MaxDouble As Double Public MinDouble As Double Public NegInfinity As Double Public PosInfinity As Double Public QuietNAN As Double Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (Destination As Any, _ source As Any, ByVal Length As Long) Private Declare Function GetProcessHeap Lib "kernel32" () As Long Private Declare Function HeapAlloc Lib "kernel32" _ (ByVal hHeap As Long, ByVal dwFlags As Long, _ ByVal dwBytes As Long) As Long Private Declare Function HeapFree Lib "kernel32" _ (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long Private Declare Sub CopyMemoryWrite Lib "kernel32" Alias _ "RtlMoveMemory" (ByVal Destination As Long, _ source As Any, ByVal Length As Long) Private Declare Sub CopyMemoryRead Lib "kernel32" Alias _ "RtlMoveMemory" (Destination As Any, _ ByVal source As Long, ByVal Length As Long)

Then the routine that does the work.

Public Sub Init() Dim ptrToDouble As Long Dim byteArray(7) As Byte Dim i As Integer byteArray(7) = &H7F 'maxdbl byteArray(6) = &HEF For i = 0 To 5 byteArray(i) = &HFF Next ptrToDouble = VarPtr(MaxDouble) CopyMemoryWrite ptrToDouble, byteArray(0), 8 byteArray(7) = &HFF 'mindbl byteArray(6) = &HEF For i = 0 To 5 byteArray(i) = &HFF Next ptrToDouble = VarPtr(MinDouble) CopyMemoryWrite ptrToDouble, byteArray(0), 8 byteArray(7) = &H7F '+inf byteArray(6) = &HF0 For i = 0 To 5 byteArray(i) = 0 Next ptrToDouble = VarPtr(PosInfinity) CopyMemoryWrite ptrToDouble, byteArray(0), 8 byteArray(7) = &HFF '-inf byteArray(6) = &HF0 For i = 0 To 5 byteArray(i) = 0 Next ptrToDouble = VarPtr(NegInfinity) CopyMemoryWrite ptrToDouble, byteArray(0), 8 byteArray(7) = &H7F 'quiet NAN byteArray(6) = &HF0 For i = 0 To 5 byteArray(i) = &HFF Next ptrToDouble = VarPtr(QuietNAN) CopyMemoryWrite ptrToDouble, byteArray(0), 8 End Sub

Finally, a slice out of the Complex Numbers project demonstrating the use of some of these declarations.

Public Function IsInfinity(c As Variant) As Boolean Dim bRes As Boolean bRes = False If TypeName(c) = "ComplexNumber" Then If c.Real = PosInfinity And c.Imag = PosInfinity Then bRes = True If c.Real = NegInfinity And c.Imag = NegInfinity Then bRes = True Else If c = PosInfinity Then bRes = True If c = NegInfinity Then bRes = True End If IsInfinity = bRes End Function

Enjoy!

© Copyright Bruce M. Axtens, 2009

[Ada (GNAT/GCC)] VARPTR, GNAT and data "transput"

Okay, have got it figured (soli Deo gloria!)

The following listings demonstrate the passing of a two part Type containing two Singles from VB6 into a GNAT/GCC DLL. Once inside, the elements of the Type are swapped and control returns to VB6. VB6 then displays the results.

As before, the code has been worked out in the context of the afore-posted api project. If you want to play with this, just take the earlier work and tweak it appropriately.

First up, the additions to api.ads:

function SwapSingles ( VarPtr : in Win32.LONG) return Win32.BOOL; ... pragma Export (DLL, SwapSingles );

Next, the additions to api.adb:

with Ada.Exceptions; use Ada.Exceptions; ... type Singles is record Part1 : Float; Part2 : Float; end record; type PointerToSingles is access Singles; function To_PointerToSingles is new Ada.Unchecked_Conversion (Win32.LONG, PointerToSingles ); function SwapSingles ( VarPtr : Win32.LONG) return Win32.BOOL is PSingles : PointerToSingles; FTemp1 : Float; FTemp2 : Float; begin PSingles:= To_PointerToSingles(VarPtr); FTemp1 := PSingles.All.Part1; FTemp2 := PSingles.All.Part2; PSingles.All.Part2 := FTemp1; PSingles.All.Part1 := FTemp2; return Win32.TRUE; exception when Constraint_Error => return Win32.FALSE; end SwapSingles;

API.DEF must also be modified, adding swapsingles to the list of EXPORTS.

Next, some VB code to demonstrate ...

Declare Function SwapSingles Lib "api.dll" (ByVal ptr As Long) As Boolean Type SinglesStruct Part1 as Single Part2 as Single End Type ... Dim Singles As SinglesStruct Singles.Part1 = 123.456 Singles.Part2 = 654.321 Debug.Print "Before:" Debug.Print "Singles.Part1 = " & Singles.Part1 Debug.Print "Singles.Part2 = " & Singles.Part2 If swapsingles(VarPtr(Singles)) = False Then Debug.Print "Constraint Error" Else Debug.Print "After:" Debug.Print "Singles.Part1 = " & Singles.Part1 Debug.Print "Singles.Part2 = " & Singles.Part2 End If

... and part of a sample output.

Before: Singles.Part1 = 123.456 Singles.Part2 = 654.321 After: Singles.Part1 = 654.321 Singles.Part2 = 123.456

The project that all this was part of was done in both GNAT/GCC and ObjectAda 7.2.2. Interestingly, ObjectAda's Float is equivalent to VB6's Double, whereas GNAT/GCC's Float is equivalent to VB6's Single. Does anyone know why?

By the way, regarding "transput", Wikipedia's article on Algol states:

ALGOL 60 as officially defined had no I/O facilities; implementations defined their own in ways that were rarely compatible with each other. In contrast, ALGOL 68 offered an extensive library of transput (ALGOL 68 parlance for Input/Output) facilities.

A extensive library of transput facilities is something you'll find in Protium, too.

© Copyright Bruce M. Axtens, 2007

[Ada (GNAT/GCC)] Passing data with VB6's VARPTR to Ada

In the current project, I've been trying to figure out how to pass data to Ada. Because I'll be passing Long, Double (Float), and two Types to emulate a LongLong and a DoubleDouble, I decided I'd use VB's VarPtr and have Ada sort the mess out on its side.

After the loss of a little hair, the reading of bits of Michael B. Feldman's Software Construction and Data Structures with Ada 95, and with help from Martin Krischik and Simon Wright, I came up with the following.

The code was worked out in the context of the afore-posted api project. If you want to play with this, just take the earlier work and stuff this into it.

First up, the additions to api.ads:

function HandlePointer ( Left : in Win32.LONG) return Win32.LONG; ... pragma Export (DLL, HandlePointer );

Next, the additions to api.adb:

function HandlePointer ( Left : in Win32.LONG) return Win32.LONG is type LongRec is record L : Win32.LONG; end record; type PointerToLongRec is access LongRec; function Conv is new Unchecked_Conversion (Win32.LONG, PointerToLongRec ); PLongRec : PointerToLongRec; begin PLongRec := Conv(Left); return PLongRec.All.L; end HandlePointer;

Next, some VB code to demonstrate ...

Declare Function handlepointer Lib "release\api.dll" (ByVal x As Long) As Long Dim i As Long i = 1001 Debug.Print "i="; i Debug.Print "varptr(i)="; VarPtr(i) Debug.Print "what ada thinks is pointed to by varptr(i)="; handlepointer(VarPtr(i))

... and a sample output.

i= 1001 varptr(i)= 1309644 what ada thinks is pointed to by varptr(i)= 1001

I'm in the process now of working out how to access the LongLong and DoubleDouble Types. Shall keep you posted.

By the way, the return value will eventually be a pointer as well. That'll keep the VB programmer on his toes.

© Copyright Bruce M. Axtens, 2007