From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,FILL_THIS_FORM,
	FREEMAIL_FROM autolearn=ham autolearn_force=no version=3.4.4
X-Google-Thread: 103376,529481ac2d77d9f6,start
X-Google-Attributes: gid103376,public
X-Google-Language: ENGLISH,ASCII-7-bit
Path: 
 g2news1.google.com!postnews.google.com!b75g2000hsg.googlegroups.com!not-for-mail
From: vienapl@hotmail.com
Newsgroups: comp.lang.ada
Subject: Translating a VB dll header to Ada
Date: 11 Apr 2007 12:48:30 -0700
Organization: http://groups.google.com
Message-ID: <1176320910.543255.74730@b75g2000hsg.googlegroups.com>
NNTP-Posting-Host: 217.126.90.204
Mime-Version: 1.0
Content-Type: text/plain; charset="iso-8859-1"
X-Trace: posting.google.com 1176320910 22067 127.0.0.1 (11 Apr 2007 19:48:30
 GMT)
X-Complaints-To: groups-abuse@google.com
NNTP-Posting-Date: Wed, 11 Apr 2007 19:48:30 +0000 (UTC)
User-Agent: G2/1.0
X-HTTP-UserAgent: Opera/9.10 (Windows NT 5.1; U; en),gzip(gfe),gzip(gfe)
Complaints-To: groups-abuse@google.com
Injection-Info: b75g2000hsg.googlegroups.com; posting-host=217.126.90.204;
   posting-account=s-5BYg0AAACg_1u2WqCKSiLkbvMBVIC_
Xref: g2news1.google.com comp.lang.ada:14915
Date: 2007-04-11T12:48:30-07:00
List-Id: <comp.lang.ada>

Greetings,
I'm a really unexperienced programmer who trying to call a dll from
Ada code. It compiles properly, but after some function calls I get
the following error: raised PROGRAM_ERROR :
EXCEPTION_ACCESS_VIOLATION.

The VB code is the following:

---------------------------------------------------------------------------------------------------
Attribute VB_Name = "modWindower"
Option Explicit
'Text Helper: (MMF Name = "WindowerMMFTextHandler")

Public Declare Function CreateTextHelper Lib
"WindowerHelper.dll" (ByVal name As String) As Long
Public Declare Sub DeleteTextHelper Lib "WindowerHelper.dll" (ByVal
helper As Long)

Public Declare Sub CTHCreateTextObject Lib "WindowerHelper.dll" (ByVal
helper As Long, ByVal name As String)
Public Declare Sub CTHDeleteTextObject Lib "WindowerHelper.dll" (ByVal
helper As Long, ByVal name As String)

Public Declare Sub CTHSetText Lib "WindowerHelper.dll" (ByVal helper
As Long, ByVal name As String, ByVal text As String)
Public Declare Sub CTHSetVisibility Lib "WindowerHelper.dll" (ByVal
helper As Long, ByVal name As String, ByVal visible As Boolean)
Public Declare Sub CTHSetFont Lib "WindowerHelper.dll" (ByVal helper
As Long, ByVal name As String, ByRef font As Byte, ByVal height As
Integer)
Public Declare Sub CTHSetColor Lib "WindowerHelper.dll" (ByVal helper
As Long, ByVal name As String, ByVal a As Byte, ByVal r As Byte, ByVal
g As Byte, ByVal b As Byte)
Public Declare Sub CTHSetLocation Lib "WindowerHelper.dll" (ByVal
helper As Long, ByVal name As String, ByVal x As Single, ByVal y As
Single)
Public Declare Sub CTHSetBold Lib "WindowerHelper.dll" (ByVal helper
As Long, ByVal name As String, ByVal bold As Boolean)
Public Declare Sub CTHSetItalic Lib "WindowerHelper.dll" (ByVal helper
As Long, ByVal name As String, ByVal italic As Boolean)
Public Declare Sub CTHSetBGColor Lib "WindowerHelper.dll" (ByVal
helper As Long, ByVal name As String, ByVal a As Byte, ByVal r As
Byte, ByVal g As Byte, ByVal b As Byte)
Public Declare Sub CTHSetBGBorderSize Lib "WindowerHelper.dll" (ByVal
helper As Long, ByVal name As String, ByVal pixels As Single)
Public Declare Sub CTHSetBGVisibility Lib "WindowerHelper.dll" (ByVal
helper As Long, ByVal name As String, ByVal visible As Boolean)
Public Declare Sub CTHSetRightJustified Lib
"WindowerHelper.dll" (ByVal helper As Long, ByVal name As String,
ByVal justified As Boolean)

Public Declare Sub CTHFlushCommands Lib "WindowerHelper.dll" (ByVal
helper As Long)

'Keyboard Helper: (MMF Name = "WindowerMMFKeyboardHandler")

Public Declare Function CreateKeyboardHelper Lib
"WindowerHelper.dll" (ByVal name As String) As Long
Public Declare Sub DeleteKeyboardHelper Lib
"WindowerHelper.dll" (ByVal helper As Long)

Public Declare Sub CKHSetKey Lib "WindowerHelper.dll" (ByVal helper As
Long, ByVal key As Byte, ByVal down As Boolean)
Public Declare Sub CKHBlockInput Lib "WindowerHelper.dll" (ByVal
helper As Long, ByVal block As Boolean)
Public Declare Sub CKHSendString Lib "WindowerHelper.dll" (ByVal
helper As Long, ByVal data As String)

'Console Helper: (MMF Name = "WindowerMMFConsoleHandler")

Public Declare Function CreateConsoleHelper Lib
"WindowerHelper.dll" (ByVal name As String) As Long
Public Declare Sub DeleteConsoleHelper Lib "WindowerHelper.dll" (ByVal
helper As Long)

Public Declare Function CCHIsNewCommand Lib
"WindowerHelper.dll" (ByVal helper As Long) As Boolean
Public Declare Function CCHGetArgCount Lib "WindowerHelper.dll" (ByVal
helper As Long) As Integer
Public Declare Sub CCHGetArg Lib "WindowerHelper.dll" (ByVal helper As
Long, ByVal index As Integer, ByVal buffer As String)
---------------------------------------------------------------------------------------------------

My Ada header looks like this:

---------------------------------------------------------------------------------------------------
with Interfaces.C;

package adawindowerhelper is

  pragma Linker_Options ("-lwindowerhelper");

  -- 'Text Helper: (MMF Name = "WindowerMMFTextHandler")

  function CreateTextHelper (name : in Interfaces.C.Char_Array) return
Interfaces.C.long; --DWORD
  pragma Import (C, CreateTextHelper, External_Name =>
"CreateTextHelper");

  procedure DeleteTextHelper (helper : in Interfaces.C.long);
  pragma Import (C, DeleteTextHelper, External_Name =>
"DeleteTextHelper");


  procedure CTHCreateTextObject (helper : in Interfaces.C.long;
                                 name : in Interfaces.C.Char_Array);
  pragma Import (C, CTHCreateTextObject, External_Name =>
"CTHCreateTextObject");

  procedure CTHDeleteTextObject (name : in Interfaces.C.Char_Array);
  pragma Import (C, CTHDeleteTextObject, External_Name =>
"CTHDeleteTextObject");


  procedure CTHSetText
   (helper : in Interfaces.C.long;
    name   : in Interfaces.C.Char_Array;
    text   : in Interfaces.C.Char_Array);
  pragma Import (C, CTHSetText, External_Name => "CTHSetText");

  procedure CTHSetVisibility
   (helper  : in Interfaces.C.long;
    name    : in Interfaces.C.Char_Array;
    visible : in Interfaces.C.int); --BOOL
  pragma Import (C, CTHSetVisibility, External_Name =>
"CTHSetVisibility");

  procedure CTHSetFont
   (helper : in Interfaces.C.long;
    name   : in Interfaces.C.Char_Array;
    font   : in Interfaces.C.Char_Array;
    height : Interfaces.C.short); --INT
  pragma Import (C, CTHSetFont, External_Name => "CTHSetFont");

  procedure CTHSetColor
   (helper : in Interfaces.C.long;
    name   : in Interfaces.C.Char_Array;
    A      : in Interfaces.C.unsigned_char; --UCHAR
    R      : in Interfaces.C.unsigned_char;
    G      : in Interfaces.C.unsigned_char;
    B      : in Interfaces.C.unsigned_char);
  pragma Import (C, CTHSetColor, External_Name => "CTHSetColor");

  procedure CTHSetLocation
   (helper : in Interfaces.C.long;
    name   : in Interfaces.C.Char_Array;
    x      : in Interfaces.C.C_float; --Single?
    y      : in Interfaces.C.C_float);
  pragma Import (C, CTHSetLocation, External_Name =>
"CTHSetLocation");

  procedure CTHSetBold
   (helper : in Interfaces.C.long;
    name   : in Interfaces.C.Char_Array;
    bold   : in Interfaces.C.int); --BOOL
  pragma Import (C, CTHSetBold, External_Name => "CTHSetBold");

  procedure CTHSetItalic
   (helper : in Interfaces.C.long;
    name   : in Interfaces.C.Char_Array;
    italic : in Interfaces.C.int); --BOOL
  pragma Import (C, CTHSetItalic, External_Name => "CTHSetItalic");

  procedure CTHSetBGColor
   (helper : in Interfaces.C.long;
    name   : in Interfaces.C.Char_Array;
    A      : in Interfaces.C.unsigned_char;
    R      : in Interfaces.C.unsigned_char;
    G      : in Interfaces.C.unsigned_char;
    B      : in Interfaces.C.unsigned_char);
  pragma Import (C, CTHSetBGColor, External_Name => "CTHSetBGColor");

  procedure CTHSetBGBorderSize
   (helper : in Interfaces.C.long;
    name   : in Interfaces.C.Char_Array;
    pixels : in Interfaces.C.C_Float);
  pragma Import (C, CTHSetBGBorderSize, External_Name =>
"CTHSetBGBorderSize");

  procedure CTHSetBGVisibility
   (helper  : in Interfaces.C.long;
    name    : in Interfaces.C.Char_Array;
    visible : in Interfaces.C.int);
  pragma Import (C, CTHSetBGVisibility, External_Name =>
"CTHSetBGVisibility");

  procedure CTHSetRightJustified
   (helper    : in Interfaces.C.long;
    name      : in Interfaces.C.Char_Array;
    justified : in Interfaces.C.int);
  pragma Import (C, CTHSetRightJustified, External_Name =>
"CTHSetRightJustified");


  procedure CTHFlushCommands (helper : in Interfaces.C.long);
  pragma Import (C, CTHFlushCommands, External_Name =>
"CTHFlushCommands");

  -- 'Keyboard Helper: (MMF Name = "WindowerMMFKeyboardHandler")

  function CreateKeyboardHelper (name : in Interfaces.C.Char_Array)
return Interfaces.C.long;
  pragma Import (C, CreateKeyboardHelper, External_Name =>
"CreateKeyboardHelper");

  procedure DeleteKeyboardHelper (helper : in Interfaces.C.long);
  pragma Import (C, DeleteKeyboardHelper, External_Name =>
"DeleteKeyboardHelper");


  procedure CKHSetKey
   (helper : Interfaces.C.long;
    key    : Interfaces.C.unsigned_char;
    down   : Interfaces.C.int);
  pragma Import (C, CKHSetKey, External_Name => "CKHSetKey");

  procedure CKHBlockInput (helper : Interfaces.C.long; block :
Interfaces.C.int);
  pragma Import (C, CKHBlockInput, External_Name => "CKHBlockInput");

  procedure CKHSendString (helper : Interfaces.C.long; data : in
Interfaces.C.Char_Array);
  pragma Import (C, CKHSendString, External_Name => "SCKHendString");

  -- 'Console Helper: (MMF Name = "WindowerMMFConsoleHandler")

  function CreateConsoleHelper (name : in Interfaces.C.Char_Array)
return Interfaces.C.long;
  pragma Import (C, CreateConsoleHelper, External_Name =>
"CreateConsoleHelper");

  procedure DeleteConsoleHelper (helper : in Interfaces.C.long);
  pragma Import (C, DeleteConsoleHelper, External_Name =>
"DeleteConsoleHelper");


  function CCHIsNewCommand (helper : Interfaces.C.long) return
Interfaces.C.int; --BOOL
  pragma Import (C, CCHIsNewCommand, External_Name =>
"CCHIsNewCommand");

  function CCHGetArgCount (helper : Interfaces.C.long) return
Interfaces.C.short; --SHORT
  pragma Import (C, CCHGetArgCount, External_Name =>
"CCHGetArgCount");

  procedure CCHGetArg
   (helper : Interfaces.C.long;
    index  : Interfaces.C.short;
    data   : in Interfaces.C.Char_Array);
  pragma Import (C, CCHGetArg, External_Name => "CCHGetArg");

end adawindowerhelper;
---------------------------------------------------------------------------------------------------

And the test code follows:

---------------------------------------------------------------------------------------------------
with adawindowerhelper; use adawindowerhelper;
with Ada.Text_IO;       use Ada.Text_IO;
with Interfaces.C;

procedure test is
  TextHelperID : Interfaces.C.long;
  c            : Character;
begin
  TextHelperID := CreateTextHelper
(Interfaces.C.To_C("WindowerMMFTextHandler"));
  Put_Line ("CreateTextHelper: Ok");
  CTHCreateTextObject (TextHelperID, Interfaces.C.To_C("Object"));
  Put_Line ("CTHCreateTextObject: Ok");
  CTHSetText (TextHelperID, Interfaces.C.To_C("Object"),
Interfaces.C.To_C("This is a sample text object."));
  Put_Line ("CTHSetText: Ok");
  CTHSetColor (TextHelperID, Interfaces.C.To_C("Object"), 255, 255,
255, 255);
  Put_Line ("CTHSetColor: Ok");
  CTHSetLocation (TextHelperID, Interfaces.C.To_C("Object"), 100.0,
100.0);
  Put_Line ("CTHSetLocation: Ok");
  CTHSetVisibility (TextHelperID, Interfaces.C.To_C("Object"), 0);
  Put_Line ("CTHSetVisibility: Ok");
  CTHFlushCommands (TextHelperID);
  Put_Line ("CTHFlushCommands: Ok");
  Get_Immediate (c);
  DeleteTextHelper (TextHelperID);
  Put_Line ("DeleteTextHelper: Ok");
  CTHFlushCommands (TextHelperID);
  Put_Line ("CTHFlushCommands: Ok");
  Get_Immediate (c);
end test;
---------------------------------------------------------------------------------------------------

On execution, I get the following:

CreateTextHelper: Ok
CTHCreateTextObject: Ok
CTHSetText: Ok
CTHSetColor: Ok

raised PROGRAM_ERROR : EXCEPTION_ACCESS_VIOLATION

I have no clue what's wrong, googled around a lot and read several
times the GNAT user's guide (I'm using GNAT GAP 2005). Any help will
be appreciated. Thank you in advance.