comp.lang.ada
 help / color / mirror / Atom feed
From: vienapl@hotmail.com
Subject: Translating a VB dll header to Ada
Date: 11 Apr 2007 12:48:30 -0700
Date: 2007-04-11T12:48:30-07:00	[thread overview]
Message-ID: <1176320910.543255.74730@b75g2000hsg.googlegroups.com> (raw)

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.




             reply	other threads:[~2007-04-11 19:48 UTC|newest]

Thread overview: 17+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2007-04-11 19:48 vienapl [this message]
2007-04-12  8:06 ` Translating a VB dll header to Ada Dmitry A. Kazakov
2007-04-12 14:17   ` vienapl
2007-04-12 17:16     ` Dmitry A. Kazakov
2007-04-13 15:25       ` vienapl
2007-04-13 16:55         ` Dmitry A. Kazakov
2007-04-14  1:05           ` vienapl
2007-04-14  7:17             ` Dmitry A. Kazakov
2007-04-14 12:16               ` vienapl
2007-04-14 14:01                 ` Philippe Bertin
2007-04-14 15:30                 ` Dmitry A. Kazakov
2007-04-14 21:37                   ` vienapl
2007-04-15 14:03                     ` vienapl
2007-04-15 15:32                       ` Dmitry A. Kazakov
2007-04-18 18:47                       ` Tarjei T. Jensen
2007-04-12 11:34 ` gautier_niouzes
2007-04-12 14:24   ` vienapl
replies disabled

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox