[Ada (GNAT/GCC)] Creating DLLs for VB6

And finally, after much prayer and perspiration, the GNAT/GCC version. Again, thanks to Roger Pearse for The Noddy Guide to using ADA code with Visual Basic. I'm sure there was someone else [This space set aside for an attribution.]

First up, api.ads, which declares the functions and exports them.

• function Factorial, which accepts a Win32.LONG and returns a Win32.LONG (I gave up on C.int as it was too small for a Factorial of 16)
• function GetCount, which returns the value of the global Count (another Win32.LONG)
• procedure Mangle, which accepts a Win32.LPWSTR and attempts the same dangerous stuff that Bob6 does in the ObjectAda version.
• function Pattern, which returns a long pointer to some string data
• procedures Initialize_API, and Finalize_API, which I understand are mandatory. (If someone knows better, please tell me.)

with Interfaces.C; use Interfaces; with Win32; use Win32; package API is Count : Win32.LONG := 0; function Factorial (Val : Win32.LONG) return Win32.LONG; function GetCount return Win32.LONG; procedure Mangle( Ptr : Win32.LPWSTR ); function Pattern return Win32.LPWSTR; procedure Initialize_API; procedure Finalize_API; private pragma Export (DLL, Initialize_API); pragma Export (DLL, Finalize_API); --pragma Export (StdCall, Count); pragma Export (DLL, GetCount ); pragma Export (DLL, Factorial ); pragma Export (DLL, Mangle ); pragma Export (DLL, Pattern ); end API;

Next, api.adb, where the declarations are explained.

I'm still working through the issue of what to do with Mangle. Perhaps two routines are needed. The first to ask the DLL how much space is needed, with VB the allocating it, and the second then actually poking the data into the allocated space.

Pattern returns a pointer to the string data. I rediscovered the technique for reading it out and that's in the VB code below. It also seems that, for as long as the DLL is loaded, the data stored in foo is available for transfer.

with Interfaces.C; use Interfaces.C; with Win32; use Win32; with Win32.Winmain; with Win32.Winbase; with System; package body API is function Factorial (Val : Win32.LONG) return Win32.LONG is Fact : Win32.LONG := 1; begin Count := Count + 1; for K in 1 .. Val loop Fact := Fact * K; end loop; return Fact; end Factorial; function GetCount return Win32.LONG is begin return Count; end GetCount; procedure Mangle( Ptr : Win32.LPWSTR ) is lp : Win32.lpwstr; foo : constant Win32.WCHAR_Array := "foo man chew" & Win32.Wide_Nul; begin lp := Win32.Winbase.lstrcpyW( Ptr, Win32.Addr(foo) ); end Mangle; function Pattern return Win32.LPWSTR is foo : constant Win32.WCHAR_Array := "martinet mongoose manticore" & Win32.Wide_Nul; begin return Win32.Addr(foo); end Pattern; procedure Initialize_API is procedure Adainit; pragma Import (C, Adainit); begin Adainit; end Initialize_API; procedure Finalize_API is procedure Adafinal; pragma Import (C, Adafinal); begin Adafinal; end Finalize_API; end API;

api.def lists the symbols exported, and is needed by gnatdll.

EXPORTS factorial mangle initialize_api finalize_api pattern getcount

Now, pulling it all together requires some handwaving on the commandline. From one of the demos I modified the make.bat to look like this:

@echo off REM first built a relocatable Ada DLL echo Build the Ada dll gnat make api -IC:\MinGW\lib\gcc\mingw32\4.2.1\stdarg -IC:\MinGW\lib\gcc\mingw32\4.2.1\win32ada gnatbind -n -x api.ali -IC:\MinGW\lib\gcc\mingw32\4.2.1\stdarg -IC:\MinGW\lib\gcc\mingw32\4.2.1\win32ada gnatlink -g -mdll -s -o api.dll api.ali -Xlinker --base-file=api.base dlltool --dllname api.dll --base-file api.base --output-exp api.exp --def api.def gnatlink -g -mdll -s -o api.dll api.ali -Xlinker --base-file=api.base api.exp

The output from a run of these is as follows:

C:\msys\1.0\home\Bruce>make Build the Ada dll gcc -c -IC:\MinGW\lib\gcc\mingw32\4.2.1\stdarg -IC:\MinGW\lib\gcc\mingw32\4.2.1\win32ada api.adb Warning: resolving _finalize_api by linking to _finalize_api@0 Use --enable-stdcall-fixup to disable these warnings Use --disable-stdcall-fixup to disable these fixups Warning: resolving _getcount by linking to _getcount@0 Warning: resolving _initialize_api by linking to _initialize_api@0 Warning: resolving _mangle by linking to _mangle@4 Warning: resolving _pattern by linking to _pattern@0 Warning: resolving _factorial by linking to _factorial@4 C:\msys\1.0\home\Bruce>

Now the VB code. Take note of a few things:

• Exporting as DLL generates decorated names, but dlltool was able to resolve the decorated ones with the undecorated ones specified in api.def
• For reasons I remember reading somewhere, initialize_api and finalize_api are mandatory, and must be the first and last calls to the DLL
• Seeing as woof woof woof woof is longer than foo man chew, s ends up containing foo man chew f woof
• As mentioned before, I rediscovered some code for getting data from a pointer and put that in. It's the PointerToString function at the bottom.

Declare Sub initialize_api Lib "api.dll" () Declare Function factorial Lib "api.dll" (ByVal x As Long) As Long Declare Function getcount Lib "api.dll" () As Long Declare Function pattern Lib "api.dll" () As Long Declare Sub mangle Lib "api.dll" (ByVal x As Long) Declare Sub finalize_api Lib "api.dll" () ' Declaration of the function which copies the character string Private Declare Function lstrcpy Lib "Kernel32.Dll " Alias "lstrcpyW" (LpszString1 As Any, LpszString2 As Any) As Long ' Declaration of the function which returns the length in the character string Private Declare Function lstrlen Lib "Kernel32.Dll " Alias "lstrlenW" (ByVal lpszString As Long) As Long Sub main() Dim s As String s = "woof woof woof woof" initialize_api Dim i As Long For i = 1 To 16 Debug.Print factorial(i); Next Debug.Print mangle StrPtr(s) Debug.Print Len(s), s Dim ptr As Long ptr = pattern() Debug.Print PointerToString(ptr) finalize_api End Sub ' Converting the pointer to the character string Function PointerToString(lngPointer As Long) As String Dim bytBuffer(255) As Byte ' Copying the character string which the pointer points to byte array lstrcpy bytBuffer(0), ByVal lngPointer ' Cutoff after the null character PointerToString = Left(bytBuffer, lstrlen(lngPointer)) End Function

Finally, a sample run under VB6

1 2 6 24 120 720 5040 40320 362880 3628800 39916800 479001600 1932053504 1278945280 2004310016 2004189184 19 foo man chew f woof martinet mongoose manticore

Next? Well, there's the issue of how to export overloaded functions and procedures. And there's the question of how to pass in complex data types, like records and the like. I'll keep you posted.

(By the way, I'm not doing this merely for the fun of it, but also in pursuit of the fulfillment of my employer's expectations. So more will follow.)

© Copyright Bruce M. Axtens, 2007